Code to save as in a specific folder and throw into an email as an attachment

[rwilard]

Hello I am trying to make a button that allows my coworkers to save as in a specific folder and email their excel forms from excel but I've run into the problem where the attachment doesn't attach. This is the code I am using, what am I doing wrong?

Dim FileName As String
Dim Path As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String

Path = "I:\AAA-PURCHASE ORDERS\2019 PO's" & ""


FileName = "PO#_" & Range("H4") & "_" & Range("C10") & Format(Now(), "mm-dd-yyyy") & ".xlsm"
Application.EnableEvents = False
ThisWorkbook.SaveAs FileName:=Path & FileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled

ErrorHandler:
Application.EnableEvents = True



On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Body content" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = ""
.Body = ""
.Display
.Attachment.Add Path & FileName
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[Perpa]

rwilard,
Welcome to the Forum.
Does this folder exist "I:\AAA-PURCHASE ORDERS\2019 PO's"
Normally a folder name cannot contain an appostrophe (single quote).
Also you need to include a backslash at the end of the Path, something like this might do the job:

Path = "I:\AAA-PURCHASE ORDERS\2019 PO_s\"

The subfolder must exist before you run your macro.
Hope this is helpful.
Perpa

 

[rwilard]

rwilard,
Welcome to the Forum.
Does this folder exist "I:\AAA-PURCHASE ORDERS\2019 PO's"
Normally a folder name cannot contain an appostrophe (single quote).
Also you need to include a backslash at the end of the Path, something like this might do the job:

Path = "I:\AAA-PURCHASE ORDERS\2019 PO_s\"

The subfolder must exist before you run your macro.
Hope this is helpful.
Perpa

Thank you for the welcome. Yes that folder does exist and the issue isn't saving it in that folder, the issue is that I cannot get excel to grab it from the folder after it saves there and throw it into outlook. Everything else about the code works (it saves, it opens outlook) but I cannot get it to attach the spreadsheet despite there being a .attachment.add code

 

[Excel Planet]

Try below (in case you save this code to personal, you can change ThisWorkbook to activeworkbook so every one can run it from their end).

Dim FileName As String
Dim Path As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String

Path = "I:\AAA-PURCHASE ORDERS\2019 PO's\"


FileName = "PO#_" & Range("H4") & "_" & Range("C10") & Format(Now(), "mm-dd-yyyy") & ".xlsm"
Application.EnableEvents = False
ThisWorkbook.SaveAs FileName:=Path & FileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled

ErrorHandler:
Application.EnableEvents = True



On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Body content" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = ""
.Body = ""
.Display
.AttachmentS.Add Path & FileName
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[rwilard]

Try below (in case you save this code to personal, you can change ThisWorkbook to activeworkbook so every one can run it from their end).

The added s on attachments worked! Thank you so much!

 

[Excel Planet]

The added s on attachments worked! Thank you so much!

We're happy we could offer a solution, thanks for the feedback..!!