excel – Personal Macro not functioning: Selecting range and pasting into body of Outlook email

While piecing together this code, I was able to get it function properly. Thinking I was done, I submitted it to someone who tried to add it as a personal macro and that was when we realized it didn’t work the same. To verify, I added it as a personal macro on my own computer and it still didn’t work.

I have blindly tried a handful of code additions such as ChartObject.Activate after ThisWorkbook.Activate but have not had success.

Sub RangeToEmailBody()

        Dim TempFilePath As String
        Dim xOutApp As Object
        Dim xOutMail As Object
        Dim xHTMLBody As String
        Dim xRg As Range
        On Error Resume Next
        Set xRg = Application.InputBox(prompt:="Please select the data range:", Type:=8)
        If xRg Is Nothing Then Exit Sub
        With Application
            .Calculation = xlManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        Set xOutApp = CreateObject("outlook.application")
        Set xOutMail = xOutApp.CreateItem(olMailItem)

        Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
        TempFilePath = Environ$("temp") & "\"
        xHTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "<img src='cid:DashboardFile.jpg'>"
        With xOutMail
            .Subject = ""
            .HTMLBody = xHTMLBody
          .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue
            .To = " "
            .Cc = " "
            .Display
        End With
End Sub

Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)

    Dim xRgPic As Range
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete

Set xRgPic = Nothing
End Sub

I would expect the selected range to show up in the body of the email but as a personal macro, there is no content inside the “picture”.

Sub createJpg(rng As Range, nameFile As String)

    Dim tempChartObj As ChartObject
    Dim tempWb As Workbook

    Set tempWb = Workbooks.Add
    Set tempChartObj = tempWb.Sheets(1).ChartObjects.Add(rng.Left, rng.Top, rng.Width, rng.Height)

    rng.CopyPicture
    With tempChartObj
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With

    tempWb.Close SaveChanges:=False

End Sub

createJpg xRg, "DashboardFile"

Tags: email, excelexcel, function, select