彰化一整天的論壇

 找回密碼
 立即註冊
查看: 821|回復: 0

【轉貼】[Excel][VBA]outlook信件內文含圖檔

[複製鏈接]
發表於 2019-8-17 19:24:33 | 顯示全部樓層 |閱讀模式
[Excel][VBA]outlook信件內文含圖檔
這裡要介紹如何使用Excel VBA
在信件內容包含截取sheet中的特定欄位區塊,
並將此區塊變為圖檔包含在內文中寄出。
現在要截取一份長這樣的檔案

有兩種方法。
第一種方法是,
先將截取的區塊存成圖檔後再將此圖檔讀取到郵件內容。
Sub PrintScreen()      '複製工作表要存圖檔的範圍        Sheets("Sheet1").Select        Set rng = Range("A1:B3")        rng.CopyPicture      ' Excel 存圖檔的精簡程式碼。        With ActiveSheet.ChartObjects.Add(1, 1, rng.Width, rng.Height)  '新增 圖表            .Chart.Paste                                                '貼上 圖片            .Chart.Export Filename:="test.PNG", Filtername:="PNG" '匯出 圖片            .Delete                                                     '刪除 圖表        End WithEnd SubSub SendMail_1()        Dim objOutlook As Object    Dim objMail As Object        Set objOutlook = CreateObject("Outlook.Application")    Set objMail = objOutlook.CreateItem(0)        With objMail        .to = "address@email.com"        .Subject = "Subject"        .Body = "mail body"        .HTMLbody = .HTMLbody & "<br><B>Embedded Image:</B><br>" _                & "<img src='test.PNG'" & "width='250' height='100'><br>" _                & "<br>Best Regards, <br>Sumit</font></span>"       ' objMail.Attachments.Add "test.PNG"       ' 使用附件檔案       '.Display     ' 可以編輯郵件內容,再按下 傳送 鍵。       '.Save         ' to save a copy in the drafts folder        .Send        ' 直接送出郵件            End With               Set objOutlook = Nothing    Set objMail = Nothing    End Sub
第二種方法是,
直接截取區要的區塊,變成圖檔,然後貼到信件內容。
Sub SendMail_2()    Set objOutlook = CreateObject("Outlook.Application")    Set objMail = objOutlook.CreateItem(0)    ' mail body    strbody = "mail body<br><br><br><br><br><br>"    'Copy range of interest    Dim r As Range    Set r = Sheets("Sheet1").Range("A1:B3")    r.Copy    'Paste as picture in sheet and cut immediately    Dim p As Picture    Set p = ActiveSheet.Pictures.Paste    p.Cut            With objMail        .to = "address@email.com"        '.cc =        '.bcc = ""        .Subject = "Subject"        .HTMLbody = strbody        '.Display            End With    'Get its Word editor    objMail.Display    Dim wordDoc As Object    Set wordDoc = objMail.GetInspector.WordEditor    'Paste picture    wordDoc.Range(Start:=wordDoc.Range.End - 3).Paste        'send mail    objMail.Send        Set objOutlook = Nothing    Set objMail = NothingEnd Sub
文章來源: http://shihs-blog.logdown.com/posts/2007909


回復

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  

GMT+8, 2020-5-29 19:02 , Processed in 0.129235 second(s), 21 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表