I found a code that turns a range of cell in Excel to a photo. That photo is delivered by mail. The problem is that when i'm using .Display
everything is OK but when i'm using .Send
the message sent empty.
Here is the code:
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
If the mail body is not updated before sending then .GetInspector will act as .Display, except for not displaying. The idea is usually associated with generating default signatures especially when the flash associated with display is annoying.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.