VBA code to create OUTLOOK email

[Blauv]

The below code copies a set cell range as an image and 2 Graphs.
It then adds them to an outlook email.

I am using Office Home and Business 2021 and Outlook.

The code was working fine until this morning when it errored with code.

31276

It errored on the Set wd.
I noticed If I changed the 4 to another number it did not error, but it also did not add the cell referenced data, only the graphs.

Any and all help here is greatly appreciated.



If olInsp.EditorType = 4 Then 'olEditorWord



Set wd = olInsp.WordEditor





Sub SendSnapShot()




Dim ol As Object 'Outlook.Application
Dim olEmail As Object 'Outlook.MailItem
Dim olInsp As Object 'Outlook.Inspector
Dim wd As Object 'Word.Document


Set ol = GetObject(, "Outlook.Application") '/* if outlook is running, create otherwise */
Set olEmail = ol.CreateItem(0) 'olMailItem


EmailTo = Sheets("Sales Report").Range("Q2").Value
EmailToCC = Sheets("Sales Report").Range("Q3").Value & " ;" & Sheets("Sales Report").Range("Q4").Value & " ;" & Sheets("Sales Report").Range("Q5").Value & " ;" & Sheets("Sales Report").Range("Q6").Value & " ;" & Sheets("Sales Report").Range("Q7").Value
todaysdate = Format(Sheets("Sales Report").Range("O1").Value, "MM-DD-YY")


With olEmail
Set olInsp = .GetInspector


Dim xChartName, xChartName1 As String
Dim xPath, xPath1 As String
Dim xChart, xChart1 As ChartObject
Dim xChartPath, xChartPath1 As String

xChartName = "Chart 3"
xChartName1 = "Chart 4"

Set xChart = Worksheets("Sales Report").ChartObjects(xChartName)
Set xChart1 = Worksheets("Sales Report").ChartObjects(xChartName1)

xChart.Chart.ChartArea.Copy
xChart1.Chart.ChartArea.Copy

' Set was missing
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

xChartPath = ThisWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_1") & ".bmp"
Debug.Print xChartPath

xChartPath1 = ThisWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_2") & ".bmp"
Debug.Print xChartPath1

xPath = " <br><p align='Left'><img src=""cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """ width=1100 height=250 >"
xChart.Chart.Export xChartPath

xPath1 = "<p align='Left'><img src=""cid:" & Mid(xChartPath1, InStrRev(xChartPath1, "\") + 1) & """ width=1100 height=250 > <br>"
xChart1.Chart.Export xChartPath1


.To = EmailTo
.CC = EmailToCC
.BCC = ""
.Subject = "Daily Sales for - " & todaysdate
.Attachments.Add xChartPath
.Attachments.Add xChartPath1
.HTMLBody = xPath & xPath1




If olInsp.EditorType = 4 Then 'olEditorWord



Set wd = olInsp.WordEditor



wd.Paragraphs(1).Range.InsertBefore Sheets("Sales Report").Range("Q8").Value & Chr(10) & Chr(10)
Range("A1:N20").SpecialCells(xlCellTypeVisible).Copy
wd.Paragraphs(wd.Paragraphs.Count).Range.Characters.First.PasteAndFormat 13
wd.Paragraphs.Add




End If



.Display
Kill xChartPath
Kill xChartPath1

End With



End Sub

[Logit]

You'll receive a quicker answer if you provide a copy of your workbook with the range and graphs. Do not include private data.

[Blauv]

My bad, and thank you.
Attached is the workbook.

the range is Sheets("Sales Report").Range("A1:N20")
31277

[Logit]

I have Outlook running in the background ... email macro worked as designed. Suggest you have a corrupt file on your end.

You can try opening the code VBE ... place your cursor at the top of the email send macro ... press F8 once press at a time and see if the macro errors out on a particular line of code. Take note of the code line and the error code.
Then return here with that information. Someone will be able to assist.

[Blauv]

The Error is in the original posting.

[Logit]

Do you have the following REFERENCES checked in your VBE ?

31278

[Aflatoon]

Does it help if you display the item before trying to access the WordInspector? I seem to recall it can be unreliable if the email isn't currently displayed.

[Blauv]

Sorry for the delay,

Came in this morning, all seems to be working fine.
Truthfully was busy with other stuff and never touched it till opening this morning.

NO Issue's running it at all.

Thank you so much for you help.

[Logit]

Don't you just love it when Excel and your computer decide to 'take over your world' ?

Glad it if back to working for you.

Merry Christmas !