[VBA] Save Range as picture, save to file, attach to email

Hi,

I am running into troubles with the following code when executing it in Excel 2016. The purpose of this code is to save a range of cells as a picture, save this picture on the desktop and then create an email with the file as an attachment. The problem only appears in Office 2016 but works fine in 2013.

Any help would be appreciated.

Sub SendSnapshotEmail()
' save a range from Excel as a picture
Dim rng As Excel.Range
Dim cht As Excel.ChartObject
Dim strRng As Range
Dim strPath As String
Dim strFile As String
Dim SendTo As String

SendTo = ThisWorkbook.Sheets("Settings").Range("B31")

' Define strings
Set strRng = ActiveWorkbook.Sheets("Snapshot").Range("A2:Q31")
strFile = "HeartBeat Snapshot - " & Format(Now(), "yyyy.mm.dd.Hh.Nn") & ".png"
strPath = CreateObject("WScript.Shell").specialfolders("Desktop")

' Speed up
With ActiveWorkbook
    .Application.ScreenUpdating = False
    .Application.EnableEvents = False
End With

' copy relevant range, turn it into an object and export to temporary folder
strRng.CopyPicture
Set cht = ActiveSheet.ChartObjects.Add(0, 0, strRng.Width, strRng.Height)
cht.Chart.Paste
cht.Chart.Export strPath & "\" & strFile
cht.Delete
 
ExitProc:

' Clean up
With ActiveWorkbook
    .Application.ScreenUpdating = True
    .Application.EnableEvents = True
End With

MsgBox "Attachment saved at: " & vbNewLine _
        & strPath & "\" & strFile, vbOKOnly, "Alert"


Set cht = Nothing
Set rng = Nothing


' Generate Outlook Email
Set OutApp = CreateObject("Outlook.Application")
    Set outMail = OutApp.CreateItem(0)

    On Error Resume Next
    With outMail
        .To = SendTo
        .CC = ""
        .BCC = ""
        .Subject = ThisWorkbook.Sheets("Settings").Range("B5") & " - Daily Emailt"
        .body = "Message body goes here"
        
        .Attachments.Add strPath & "\" & strFile
        .Display
        
    End With
    On Error GoTo 0

    Set outMail = Nothing
    Set OutApp = Nothing
End Sub