通过邮件发送Excel图表（Outlook）
我发现了一个代码，将Excel中的一系列单元格转换为照片。 这张照片是通过邮件递送的。 问题是，当我使用。显示一切正常，但是当我使用。发送消息发送空。
这里是代码：
Sub Send_Pt_mail() Dim OutApp As Object Dim OutMail As Object Dim Fname As String Dim ch As ChartObject 'Prepare screen data file Set ch = Worksheets("Chart").ChartObjects.Add(Range("Photo2Mail").Left, Range("Photo2Mail").Top, Range("Photo2Mail").Width, Range("Photo2Mail").Height) 'calculating the number of Recipients iRow = Worksheets("Recipients").Cells(Rows.Count, 1).End(xlUp).Row Recipients = "" For i = 2 To iRow 'for each record in Recipients sheet an eMail will be send If ThisWorkbook.Worksheets("Recipients").Cells(i, 2).Value = ThisWorkbook.Worksheets("Recipients").Cells(2, 7).Value Then Recipients = Recipients & ThisWorkbook.Worksheets("Recipients").Cells(i, 1) & ";" End If Next i 'Prepare mail range as an image Application.ScreenUpdating = True Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) Fname = Environ$("temp") & "Mail_snap" & ".gif" 'select the relevant table (update or new data) and export through Chart to file 'then select the charts in dashboard and export through Chart 18 to file ch.Chart.ChartWizard Source:=Worksheets("DB").Range("Photo2Mail"), gallery:=xlLine, Title:="New Chart" ' ch.Chart.ChartArea.ClearContents ' ch.Width = 1700 ' ch.Height = 900 Chart_Name = ch.Name Worksheets("DB").Activate Range("Photo2Mail").Select Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap Worksheets("Chart").ChartObjects(Chart_Name).Activate ActiveChart.Paste ActiveWorkbook.Worksheets("Chart").ChartObjects(Chart_Name).Chart.Export Filename:=Fname, FilterName:="gif" S = "<img src=" & Fname & "><br>" 'On Error Resume Next With OutMail .To = Recipients .CC = "" .BCC = "" .Subject = ThisWorkbook.Worksheets("Recipients").Cells(3, 4) & " " & Format(Now(), "dd/mm/yyyy") .Save .HTMLBody = S ' send .display End With On Error GoTo 0 Kill Fname ch.Delete StopMacro: Set OutMail = Nothing Set OutApp = Nothing Application.ScreenUpdating = False If (ActiveWindow.Zoom <> 100) Then ActiveWindow.Zoom = 100 End If End Sub
如果邮件正文在发送之前没有更新，那么.GetInspector将作为.Display，除非不显示。 这个想法通常与生成默认签名有关，特别是当与显示相关的闪光灯很烦人时。
Sub Send_With_Signature_Demo() Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = "myaddress@somewhere.com" .Subject = Format(Now(), "dd/mm/yyyy") ' If you have a default signature ' you should find you need either .GetInspector or .Display .GetInspector .Save .Send End With StopMacro: Set OutMail = Nothing Set OutApp = Nothing End Sub