编辑-（http://vba-useful.blogspot.com/2014/01/send-html-email-with-embedded-images.html）

上面的链接详细说明了如何制作jpg的范围，并发送在电子邮件中。
我发现了一些非常相似的代码，似乎使用了稍微不同的方法。也许它会工作。它似乎绕过了您正在尝试的Mail.Envelope方法。从Ron de Bruin's页面。不幸的是，我无法在当前机器上测试它，所以我希望它能有所帮助。

Sub Make_Outlook_Mail_With_File_Link()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Excel 2000-2013
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    If ActiveWorkbook.Path <> "" Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Colleagues,<br><br>" & _
                  "I want to inform you that the next sales Order :<br><B>" & _
                  ActiveWorkbook.Name & "</B> is created.<br>" & _
                  "Click on this link to open the file : " & _
                  "<A HREF=""file://" & ActiveWorkbook.FullName & _
                  """>Link to the file</A>" & _
                  "<br><br>Regards," & _
                  "<br><br>Account Management</font>"

        On Error Resume Next
        With OutMail
            .To = "[email protected]"
            .CC = ""
            .BCC = ""
            .Subject = ActiveWorkbook.Name
            .HTMLBody = strbody
            .Display   'or use .Send
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    Else
        MsgBox "The ActiveWorkbook does not have a path, Save the file first."
    End If
End Sub

字符串

这应该工作。我已经测试了它与网站链接，而不是与您的文件结构，但它应该工作。

Sub SendRangeAsPictureInMailWithHyperlink()
    Dim OutlookApp As Object
    Dim Mail As Object
    Dim WordDoc As Object
    Dim ExcelRange As Range
    Dim InlineShape As Object

    ' Define the range in Excel that you want to copy
    Set ExcelRange = ThisWorkbook.Sheets("YourSheetName").Range("A1:C3")

    ' Copy the range as a picture
    ExcelRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    ' Create an Outlook instance
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set OutlookApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    ' Create a new email
    Set Mail = OutlookApp.CreateItem(0)

    With Mail
        .To = "[email protected]"   ' Set the recipient
        .Subject = "Subject of the Email"  ' Set the subject
        .HTMLBody = "<font size=""3"" face=""Calibri"">" & _
                ActiveWorkbook.Name & "</B> is created.<br>" & _
                "Click on this picture to open the file :"  ' Set the body text of the email

        ' Display the email window
        .Display

        ' Insert picture at the end of the email text
        Set WordDoc = .GetInspector.WordEditor
        WordDoc.Range.InsertAfter vbCrLf & vbCrLf  ' Adds two new lines at the end
        WordDoc.Range.Characters.Last.Paste
        Set InlineShape = WordDoc.InlineShapes(WordDoc.InlineShapes.Count)
        
        ' Add a hyperlink to the picture
        With WordDoc.Hyperlinks
            .Add Anchor:=InlineShape, Address:="file://" & ActiveWorkbook.fullname  'Or Address:="https://www.google.com/"
        End With
        
    End With

    ' Cleanup
    Set Mail = Nothing
    Set OutlookApp = Nothing
    Set ExcelRange = Nothing
End Sub

字符串
：）