Search code examples
excelvbaoutlook

How do I adjust the size of the pasted image in Outlook email?


Looking at old questions here on the site I found the code I needed, but I need to adjust the size (height and width) of the image pasted in the email, but I was unsuccessful. Can you help me?

Sub SendEmail()
    'Open a new mail item
    Set outlookApp = CreateObject("Outlook.Application")
   
    Set OutMail = outlookApp.CreateItem(olMailItem)
    
    With OutMail
        .To = ""
        .Subject = "** Please confirm Timesheet by 10:30AM **"
        .Importance = olImportanceHigh
        .Display
    End With

    'Get its Word editor
    Set wordDoc = OutMail.GetInspector.WordEditor

    'To paste as picture
    rng.Copy
    wordDoc.Range.PasteSpecial , , , , wdPasteBitmap

    OutMail.HTMLBody = "Timesheets Submitted by " & "Marco" & "<br>" & _
    vbNewLine & OutMail.HTMLBody
End Sub

I tried to create some command to resize image size but without success.


Solution

  • Is this what you are trying? I have commented the code but if you get stuck then simply ask.

    Option Explicit
    
    '~~> Since we are working using Late Binding
    
    '~~> Outlook Constants
    Private Const olImportanceHigh = 2
    Private Const olMailItem = 0
    
    '~~> Word Constant
    Private Const wdChartPicture = 13
    
    Sub SendEmail()
        '~~> Worksheet Operations
        Dim ws As Worksheet
        Dim rng As Range
        Dim pic As Picture
            
        '~~> Change this to the relevant sheet
        Set ws = Sheet1
        '~~> Change this to the relevant range
        Set rng = ws.Range("A1:A15")
        
        '~~> Copy the range and paste it in a picture object
        rng.Copy
        Set pic = ws.Pictures.Paste
        
        '~~> Set the dimensions here
        With pic.ShapeRange
            .LockAspectRatio = msoTrue
            .Height = 200
            .Width = 200
        End With
        
        '~~> Outlook Operations
        Dim OutApp As Object
        Dim OutMail As Object
     
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)
        
        With OutMail
            .To = ""
            .Subject = "** Please confirm Timesheet by 10:30AM **"
            .Importance = olImportanceHigh
            .Display
        End With
    
        Dim wordDoc As Object
        Set wordDoc = OutMail.GetInspector.WordEditor
        
        '~~> Cut the picture and paste in email
        pic.Cut
        DoEvents
        
        wordDoc.Range.pasteandformat wdChartPicture
    
        OutMail.HTMLBody = "Timesheets Submitted by Marco" & _
                           "<br>" & _
                           vbNewLine & OutMail.HTMLBody
    End Sub
    

    One important tip: Always declare and work with Objects/Variables. Will make your life easier...