Blauv
12-20-2023, 06:42 AM
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
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