VBA Excel：如何通过电子邮件将保存在Excel中的图像发送到硬盘上？

Question

我有一些代码可以从Excel复制单元格，将它们粘贴为图片，保存图片，然后在其正文中发送包含该图片的电子邮件。问题是因为图像保存在我的硬盘上，当它被发送给收件人时无法看到图像。有办法解决这个问题吗？

代码如下：

Sub Email()

Dim objOutlook As Object
Dim objMail As Object
Dim TempFilePath As String
Dim Location As String
Dim RecipientNumber As String
Dim rng As Range
Dim PrimaryRecipients As String
Dim SecondaryRecipients As String
Dim To_Name As String



Worksheets("Contacts").Activate
Range("A2").Select

While ActiveCell <> "" And ActiveCell <> "0"

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

     ActiveCell.Offset(1, 0).Select
     RecipientNumber = ActiveCell.Value
     To_Name = ActiveCell.Offset(0, 4).Value
     If To_Name = "" Or To_Name = "0" Then
         To_Name = ActiveCell.Offset(0, 7).Value


     Worksheets("Output 2").Activate
     Range("C2").Value = RecipientNumber 

     Dim objChart As Chart
     Call ActiveSheet.Range("A1:M28").CopyPicture(xlScreen, xlPicture)
     Sheets.Add.Name = "Without Formatting"
     Worksheets("Without Formatting").Shapes.AddChart
     Worksheets("Without Formatting").Activate
     ActiveSheet.Shapes.Item(1).Select
     Set objChart = ActiveChart
     objChart.Paste

     With ActiveChart.Parent
      .Height = 300 ' resize
      .Width = 750  ' resize
      .Top = 100    ' reposition
      .Left = 100   ' reposition
      End With

      Dim DayForLocation As String
      Dim MonthForLocation As String
      Dim YearForLocation As String
      Dim DateForLocation As String
      DayForLocation = Day(Now)
      MonthForLocation = Month(Now)
      YearForLocation = Year(Now)
      DateForLocation = YearForLocation & MonthForLocation & DayForLocation

      Dim FileLocation As String
      FileLocation = "C:\Users\asfadsf\Documents\" & DateForLocation

      If Dir("C:\Users\asfadsf\Documents\" & DateForLocation) <> "" Then
          MkDir ("C:\Users\asfadsf\Documents\" & DateForLocation)
      End If
      FileLocation = FileLocation & RecipientNumber & ".jpeg"
      objChart.Export (FileLocation)

      Set rng = ActiveSheet.Range("A1:M28").Rows.SpecialCells(xlCellTypeVisible)
      If rng Is Nothing Then
          MsgBox "The selection is not a range or the sheet is protected" & _
                 vbNewLine & "please correct and try again.", vbOKOnly
          Exit Sub
      End If

      'Keep_Format

      With objMail
         .To = PrimaryRecipients
         .Cc = SecondaryRecipients
         .Subject = "Information: " & RecipientNumber & " Updated Profiler"

         Dim Greeting As String
         If Time >= #12:00:00 PM# Then
             Greeting = "Afternoon"
         Else
             Greeting = "Morning"
         End If

         Dim LastMonth As String
         LastMonth = MonthName((Month(Date)) - 1)

         Dim InsertImage As String
         InsertImage = "<img src='" & FileLocation & "'>"

         .HTMLBODY = "<font face=Arial><p>" & "Good " & Greeting & " " & To_Name & "," & "</p>"
         .HTMLBODY = .HTMLBODY + "<p>" & "Email text." & "</p>"
         .HTMLBODY = .HTMLBODY + "<p>" & "Email text." & "</p>"
         .HTMLBODY = .HTMLBODY + "<p>" & "Email text." & "</p>"
        ' .HTMLBODY = .HTMLBODY + RangetoHTML(rng)
         .HTMLBODY = .HTMLBODY + InsertImage
         .HTMLBODY = .HTMLBODY + "<p>" & "Kind Regards" & "<br>"
         .HTMLBODY = .HTMLBODY + "<img src='C:\Users\asfadsf\Documents\test.jpg'>"
         .Send
       End With
       Worksheets("Contacts").Activate
       Application.DisplayAlerts = False
       Sheets("Without Formatting").Delete
       Application.DisplayAlerts = True
Wend

Set objOutlook = Nothing
Set objMail = Nothing

Set objOutlook = Nothing
Set objMail = Nothing


End Sub

这是一个很大的问题，有人可以帮忙吗？