通過郵件發送Excel圖表（Outlook）

我發現了一個代碼，可以將Excel中單元格的範圍轉換爲照片。這張照片是通過郵件發送的。問題是，當我使用.Display一切正常，但是當我使用.Send發送的消息爲空。通過郵件發送Excel圖表（Outlook）

下面是代碼：

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

來源

2017-02-26 Eran

如果郵件正文不發送，然後.GetInspector將作爲。顯示，除了不顯示更新之前。這個想法通常與生成默認簽名有關，尤其是當與顯示相關的閃光燈很煩人時。

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 = "[email protected]" 
     .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

來源

2017-02-26 16:21:37 niton

問題是。發送（它怎麼可能。顯示的偉大工程，但發送。發送一個空的電子郵件？） – Eran

爲什麼不。發送沒有這個.GetInspector功能的問題留給別人用更好地瞭解Outlook VBA。 – niton

通過郵件發送Excel圖表（Outlook）

回答

相關問題