Forum Discussion
VBA creates PDF attachment & saves but does not generate the email and attach
Cell P20 should contain the path and filename. The code will add the sheet name to it, plus the extension .pdf.
If P20 does not contain the path, you should add it in the code:
PdfFile = ThisWorkbook.Path & "\" & Title
I'd - at least temporarily - change .Send to .Display
Outlook should then display the email message for you to inspect. You can click Send manually.
I am having this same issue with different spreadsheets. These were all built by someone who self taught VBA. They work sometimes but when they don't work it is always the same error.
Below is an example:
The bold italic is where I always get the error.
Appreciate any help.
- HansVogelaarDec 09, 2022MVP
I don't see an example...
- SbrowningApr 11, 2023Copper Contributor
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & ".pdf"
With Sheets("Cash Over Short")
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
With OutlApp.CreateItem(0)
.Subject = Title
.To = Sheets("Reference").Range("A30").Value
.CC = ""
.Body = "Hi," & vbLf & vbLf _
& "Please find L&L daily cash over/short in PDF attachment." & vbLf & vbLf _
& "Regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
Kill PdfFile
If IsCreated Then OutlApp.Quit
Set OutlApp = Nothing
ElseIf Sheets("Closing Count").Range("B1") = "Michael Jordan" Then
Dim IsCreatedMJ As Boolean
Dim iMJ As Long
Dim PdfFileMJ As String, TitleMJ As String
Dim OutlAppMJ As Object
TitleMJ = Format(Sheets("Cash Over Short").Range("B14"), "mm/dd/yy") & " " & "Michael Jordan Cash Over Short"
PdfFileMJ = "MJ Cash Over Short" & " " & Format(Sheets("Cash Over Short").Range("B14"), "yymmdd")
iMJ = InStrRev(PdfFileMJ, ".")
If iMJ > 1 Then PdfFileMJ = Left(PdfFileMJ, iMJ - 1)
PdfFileMJ = PdfFileMJ & ".pdf"
With Sheets("Cash Over Short")
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFileMJ, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
On Error Resume Next
Set OutlAppMJ = GetObject(, "Outlook.Application")
If Err Then
Set OutlAppMJ = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlAppMJ.Visible = True
On Error GoTo 0
With OutlAppMJ.CreateItem(0)
.Subject = TitleMJ
.To = Sheets("Reference").Range("B30").Value
.CC = ""
.Body = "Hi," & vbLf & vbLf _
& "Please find MJ daily cash over/short in PDF attachment." & vbLf & vbLf _
& "Regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFileMJ
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
Kill PdfFileMJ
If IsCreated Then OutlAppMJ.Quit
Set OutlAppMJ = Nothing
Else
End If
End Sub- HansVogelaarApr 11, 2023MVP
It's difficult to understand the logic of your code, especially since you didn't post all of it, and since the posted version doesn't have any indentation. Perhaps this?
If i > 1 Then PdfFile = Left(PdfFile, i - 1) PdfFile = PdfFile & ".pdf" With Sheets("Cash Over Short") .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End With On Error Resume Next Set OutlApp = GetObject(, "Outlook.Application") If Err Then Set OutlApp = CreateObject("Outlook.Application") IsCreated = True End If OutlApp.Visible = True On Error GoTo 0 With OutlApp.CreateItem(0) .Subject = Title .To = Sheets("Reference").Range("A30").Value .CC = "" .Body = "Hi," & vbLf & vbLf _ & "Please find L&L daily cash over/short in PDF attachment." & vbLf & vbLf _ & "Regards," & vbLf _ & Application.UserName & vbLf & vbLf .Attachments.Add PdfFile On Error Resume Next .Send Application.Visible = True If Err Then MsgBox "E-mail was not sent", vbExclamation Else MsgBox "E-mail successfully sent", vbInformation End If On Error GoTo 0 End With Kill PdfFile If IsCreated Then OutlApp.Quit Set OutlApp = Nothing ElseIf Sheets("Closing Count").Range("B1") = "Michael Jordan" Then Dim IsCreatedMJ As Boolean Dim iMJ As Long Dim PdfFileMJ As String, TitleMJ As String Dim OutlAppMJ As Object TitleMJ = Format(Sheets("Cash Over Short").Range("B14"), "mm/dd/yy") & " " & "Michael Jordan Cash Over Short" PdfFileMJ = "MJ Cash Over Short" & " " & Format(Sheets("Cash Over Short").Range("B14"), "yymmdd") iMJ = InStrRev(PdfFileMJ, ".") If iMJ > 1 Then PdfFileMJ = Left(PdfFileMJ, iMJ - 1) PdfFileMJ = PdfFileMJ & ".pdf" With Sheets("Cash Over Short") .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFileMJ, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End With On Error Resume Next Set OutlAppMJ = GetObject(, "Outlook.Application") If Err Then Set OutlAppMJ = CreateObject("Outlook.Application") IsCreated = True End If OutlAppMJ.Visible = True On Error GoTo 0 With OutlAppMJ.CreateItem(0) .Subject = TitleMJ .To = Sheets("Reference").Range("B30").Value .CC = "" .Body = "Hi," & vbLf & vbLf _ & "Please find MJ daily cash over/short in PDF attachment." & vbLf & vbLf _ & "Regards," & vbLf _ & Application.UserName & vbLf & vbLf .Attachments.Add PdfFileMJ On Error Resume Next .Send Application.Visible = True If Err Then MsgBox "E-mail was not sent", vbExclamation Else MsgBox "E-mail successfully sent", vbInformation End If On Error GoTo 0 End With Kill PdfFileMJ If IsCreated Then OutlAppMJ.Quit Set OutlAppMJ = Nothing End If End Sub