Как отправить письмо из Outlook со встроенным изображением, используя VBA? - PullRequest
Новая
       36

Как отправить письмо из Outlook со встроенным изображением, используя VBA?

0 голосов
/ 20 мая 2018

Я пишу код для вставки диапазона A11:K82 в тело сообщения Outlook, включая таблицы и диаграммы.Мне нужно вставить его в редактируемый формат.Я завершил кодирование для этого, но мои графики не отображались.

Пожалуйста, помогите мне завершить. 

Sub Mail()
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Worksheets("SS Night Letter").Activate
    subb = Range("b11").Value
    Set rng = Nothing

    ' Only send the visible cells in the selection.
    Worksheets("Distribution List").Activate
    distlist = Range("c3").Value
    Worksheets("SS Night Letter").Activate

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .to = distlist
        .CC = ""
        .BCC = ""
        .Subject = subb
        .HTMLBody = RangetoHTML(rng)
        .Display
    End With

    On Error GoTo 0
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Function RangetoHTML(rng As Range)
    ' By Ron de Bruin
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    mm = ActiveWorkbook.Name
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".html"

    'Copy the range and create a new workbook to past the data in
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        Workbooks(mm).Activate
        Range("A11:K81").Select
        Selection.Copy
        TempWB.Activate
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
            SourceType:=xlSourceRange, _
            Filename:=TempFile, _
            Sheet:=TempWB.Sheets(1).Name, _
            Source:=TempWB.Sheets(1).UsedRange.Address, _
            HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
        "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing

End Function

img

Пожалуйста, поддержите меня, чтобы решить это.

...