Excel Code Not Working Anymore

[IrishGuy725]

I have a macro code that is designed to save an excel sheet as a PDF AND email it out when you click the button. It still saves the sheet as a pdf and exports it to the correct folder. However, it is not emailing it out and I get an error message every time I try (error 287). This is the code:
Sub SavePdfAndSendEmail()

On Error GoTo err_handler

Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem

Dim folderPath As String
Dim pdfFileName As String

'// Construct the file path and name
folderPath = "XXX"
pdfFileName = Sheets("Info").Range("C2").Value & ".pdf"

'// Export the workbook as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=folderPath & pdfFileName

'// Open Outlook and create a new email
Set oApp = New Outlook.Application
Set oMail = oApp.CreateItem(olMailItem)

With oMail
.To = "XXX"
.CC = ""
.Subject = "ASAP" & pdfFileName
.Body = "Please review this ASAP"
.Attachments.Add Source:=folderPath & pdfFileName, Type:=xlTypePDF
.Send

End With

clean_exit:
Set oMail = Nothing
Set oApp = Nothing
Exit Sub


err_handler:
'Something has gone wrong, spit out an error messsage
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Error"
GoTo clean_exit

End Sub

I can't figure it out. Any help would be GREATLY appreciated

 

[Domenic]

Try displaying the email before sending it, like this...

With oMail
.Display  '<--------------------
.To = "XXX"
.CC = ""
.Subject = "ASAP" & pdfFileName
.Body = "Please review this ASAP"
.Attachments.Add Source:=folderPath & pdfFileName, Type:=xlTypePDF
.Send

End With

Does this help?

 

[IrishGuy725]

Yes, it helps in that it automatically brings up the Outlook/email app and then I just have to hit "send." However, before, it automatically sent it without displaying the email first.

 

[IrishGuy725]

Also, even with that, I get the "287: Application-defined or object-defined error" message when I go to close out

 

[IrishGuy725]

Try displaying the email before sending it, like this...

With oMail
.Display  '<--------------------
.To = "XXX"
.CC = ""
.Subject = "ASAP" & pdfFileName
.Body = "Please review this ASAP"
.Attachments.Add Source:=folderPath & pdfFileName, Type:=xlTypePDF
.Send

End With

Does this help?

Yes, it helps in that it automatically brings up the Outlook/email app and then I just have to hit "send." However, before, it automatically sent it without displaying the email first. Also, even with that, I get the "287: Application-defined or object-defined error" message when I go to close out

 

[Domenic]

First, just to be clear, I did not remove the .Send line from your code. I simply added .Display at the beginning of it. So the code that I offered should first display the email, and then automatically send it. So there should be no need to manually click on Send.

I would suggest that you try again with the exact code that I posted. However, if you still get an error, temporarily comment out or remove your error handling, run it again, and see which line causes the error. Then, post the exact error (number and description) that you're getting, along with the line causing the error.

 

[IrishGuy725]

First, just to be clear, I did not remove the .Send line from your code. I simply added .Display at the beginning of it. So the code that I offered should first display the email, and then automatically send it. So there should be no need to manually click on Send.

I would suggest that you try again with the exact code that I posted. However, if you still get an error, temporarily comment out or remove your error handling, run it again, and see which line causes the error. Then, post the exact error (number and description) that you're getting, along with the line causing the error.

Hmmm...I checked the codes (there are two others that work with this one) but I can't find an error anywhere and it isn't giving me an error line to reference. Maybe I'll just stick with the manual process lol
This is another code to save the file/pictures:

Sub PDFActiveSheetNoPromptCheck()

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet

'get active workbook folder, if saved
strPath = "XXX"
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

strName = wsA.Range("A1").Value _
& " - " & wsA.Range("A2").Value _
& " - " & wsA.Range("A3").Value

'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile

If bFileExists(strPathFile) Then
lOver = MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists")
If lOver <> vbYes Then
'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
strPathFile = myFile
Else
GoTo exitHandler
End If
End If
End If

'export to PDF in current folder
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function

...and here is the button code to make it do both in one step:
Sub Button1_Click()
Call SavePdfAndSendEmail 'Macro1
Call PDFActiveSheetNoPromptCheck 'Macro2
End Sub

 

[Domenic]

How about if you try it again, making sure that you comment out any error handling, but this time run through your code line-by-line by pressing the F8 key? This way you should be able to see which line is giving you the error.