Adding a screenshot of a cell range in excel and inserting into an Outlook email body via a VBA macro - Stack Overflow

I am trying to insert a screenshot of an Excel cell range from a specific Sheet into the email body of

I am trying to insert a screenshot of an Excel cell range from a specific Sheet into the email body of an outlook message via a macro button. I've tried saving an image as a temporary file but even this doesn't work (and I'd rather avoid that method if possible). Has anyone any suggestions how I can literally grab a cell range in a macro and put that into the email body? Thanks in advance

Sub TakeScreenshotAndEmail()
    Dim ws As Worksheet
    Dim rng As Range
    Dim chartObj As ChartObject
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim emailDate As String
    Dim tempFilePath As String
    Dim tempFileName As String
    Dim imgTag As String
    Dim senderName As String
    
    On Error GoTo ErrorHandler
    
    ' Set the worksheet and range
    Set ws = ThisWorkbook.Sheets("Summary") ' Change to "Summary" tab
    Set rng = ws.Range("A1:N44") ' Change the range as needed
    
    ' Define the temporary file path and name
    tempFilePath = Environ("TEMP") & "\"
    tempFileName = tempFilePath & "temp_image.png"
    
    ' Check if the temporary file path exists
    If Dir(tempFilePath, vbDirectory) = "" Then
        MsgBox "Temporary file path does not exist: " & tempFilePath, vbCritical, "Error"
        Exit Sub
    End If
    
    ' Create a temporary chart to hold the screenshot
    Set chartObj = ws.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height)
    
    ' Copy the range as a picture
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    chartObj.Chart.Paste
    chartObj.Chart.Export FileName:=tempFileName, Filtername:="PNG"
    chartObj.Delete
    
    ' Get the date from cell H3
    emailDate = Format(ws.Range("H3").Value, "dd.mm.yyyy")
    
    ' Create an Outlook email
    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)
    
    ' Get the sender's name
    senderName = outlookApp.Session.CurrentUser.Name
    
    ' Create the HTML body with the image tag
    imgTag = "<img src='cid:image1'>"
    
    With outlookMail
        .To = "" ' Change to your recipient
        .CC = ""
        .BCC = ""
        .Subject = "" & emailDate
        .HTMLBody = ""
        
        ' Embed the image in the email
        .Attachments.Add tempFileName, 1, 0, "image1"
        
        .Display ' Use .Send to send the email directly
    End With
    
    ' Clean up
    Kill tempFileName
    Set outlookMail = Nothing
    Set outlookApp = Nothing
    
    Exit Sub
    
ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
End Sub

I tried to write a script several times but naturally failed as this is my first time trying to write a macro

发布者:admin,转转请注明出处:http://www.yc00.com/questions/1744220206a4563744.html

相关推荐

发表回复

评论列表(0条)

  • 暂无评论

联系我们

400-800-8888

在线咨询: QQ交谈

邮件:admin@example.com

工作时间:周一至周五,9:30-18:30,节假日休息

关注微信