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

Question

viewing older questions on this site I was able to locate the code I required, but I was unsuccessful in changing the image's dimensions (height and width). Can you assist 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 commands to resize the image size but without success.

Answer 1

Try this :

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