Sending email and adding 2 attachments from excel

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
886
Office Version
  1. 365
Platform
  1. Windows
I have 2 codes, one that creates a pdf and the other that sends an email.
I merged them below but want to add 2 pdf attachments to the email: the one I just created and another located in the same directory.
(Note: if that file is not found, a msg stating this would be preferred just in case of error)

Attachments I want to add are located in the same path: Sheets("CI Form Open").Range("T1")
Name of #1 is in: T2.pdf
Name of #2 is in: N2.pdf

Any help would be greatly appreciated! :)

VBA Code:
Sub SavePDF_send mail()
'
' SavePDF_send mail Macro
'
Dim Path As String
Dim filename As String

Path = Sheets("CI Form Open").Range("T1")
filename = Sheets("CI Form Open").Range("T2")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=Path & filename & ".pdf", Quality:=xlQualityStandard, _
  IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True


 Dim OutlookApp As Object, MItem As Object
  Set OutlookApp = CreateObject("Outlook.Application")
  Set MItem = OutlookApp.CreateItem(0)
  With MItem
    .to = Sheets("CI Form Open").Range("T3")
    .Subject = Sheets("CI Form Open").Range("N2")
    .Body = "[This is an Automated Message - Do not reply]" & vbCrLf & "Continuous Improvement Database"
    .Display
    .Send
  End With
MsgBox "E-mail Sent"
  Case vbNo
        GoTo Quit:
    End Select

Quit:
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
VBA Code:
Sub SavePDF_send_mail()
' SavePDF_send mail Macro
'
Dim Path As String
Dim filename As String


Path = Sheets("sheet2").Range("T1")
filename = Sheets("sheet2").Range("T2")


ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=Path & "\" & filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False


 Dim OutlookApp As Object, MItem As Object
  Set OutlookApp = CreateObject("Outlook.Application")
  Set MItem = OutlookApp.CreateItem(0)
  On Error GoTo MSG
  With MItem
    .to = Sheets("sheet2").Range("T3")
    .Subject = Sheets("sheet2").Range("N2")
    .Body = "[This is an Automated Message - Do not reply]" & vbCrLf & "Continuous Improvement Database"


    .Attachments.Add Path & "\" & filename & ".pdf"
    .Attachments.Add Path & "\" & "N2" & ".pdf"
 
    .Display
  End With
MsgBox "E-mail Sent"
Exit Sub
MSG: MsgBox " No N2 file found"
End Sub
 
Upvote 0
Solution
VBA Code:
Sub SavePDF_send_mail()
' SavePDF_send mail Macro
'
Dim Path As String
Dim filename As String


Path = Sheets("sheet2").Range("T1")
filename = Sheets("sheet2").Range("T2")


ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=Path & "\" & filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False


 Dim OutlookApp As Object, MItem As Object
  Set OutlookApp = CreateObject("Outlook.Application")
  Set MItem = OutlookApp.CreateItem(0)
  On Error GoTo MSG
  With MItem
    .to = Sheets("sheet2").Range("T3")
    .Subject = Sheets("sheet2").Range("N2")
    .Body = "[This is an Automated Message - Do not reply]" & vbCrLf & "Continuous Improvement Database"


    .Attachments.Add Path & "\" & filename & ".pdf"
    .Attachments.Add Path & "\" & "N2" & ".pdf"
 
    .Display
  End With
MsgBox "E-mail Sent"
Exit Sub
MSG: MsgBox " No N2 file found"
End Sub

I only get the error message No file found but the file is present in the folder (see below code and screenshots)
Don't know where the error is occurring...

VBA Code:
Sub SavePDF_send_mail()
' SavePDF_send mail Macro
'
Dim Path As String
Dim filename As String


Path = Sheets("CI Form Open").Range("T1")
filename = Sheets("CI Form Open").Range("T2")


ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=Path & "\" & filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False


 Dim OutlookApp As Object, MItem As Object
  Set OutlookApp = CreateObject("Outlook.Application")
  Set MItem = OutlookApp.CreateItem(0)
  On Error GoTo MSG
  With MItem
    .to = Sheets("CI Form Open").Range("T3")
    .Subject = Sheets("CI Form Open").Range("N2")
    .Body = "[This is an Automated Message - Do not reply]" & vbCrLf & "Continuous Improvement Database"


    .Attachments.Add Path & "\" & filename & ".pdf"
    .Attachments.Add Path & "\" & "N2" & ".pdf"
 
    .Display
  End With
MsgBox "E-mail Sent"
Exit Sub
MSG: MsgBox " No IAR file found" 'Only get this message but file is present'
End Sub

1678291870355.png


1678292211851.png
 

Attachments

  • 1678291604026.png
    1678291604026.png
    11.2 KB · Views: 6
Upvote 0
change below "n2" to the file name already in folder
VBA Code:
.Attachments.Add Path & "\" & "N2" & ".pdf"
 
Upvote 0
change below "n2" to the file name already in folder
VBA Code:
.Attachments.Add Path & "\" & "N2" & ".pdf"
The file name is subject to change so I require a cell reference. Can this be done with a cell reference?
 
Upvote 0
I figured it out. Thank you :giggle:

VBA Code:
.Attachments.Add Path & "\" & Sheets("CI Form Open").Range("N2") & ".pdf"
 
Upvote 0
Yes
as long as you capture path- example T4 shows C:\Users\xxxxx\Desktop\files\Daily.pdf
VBA Code:
.Attachments.Add Range("T4").Value
 
Upvote 0

Forum statistics

Threads
1,214,792
Messages
6,121,612
Members
449,039
Latest member
Mbone Mathonsi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top