Hi,
I have some code which I found, possibly on this forum but cant remember, and I have edited it to do exactly as I require.
The code generates an email , adds 4 attachments, adds defined recipients and displays the email allowing for final checks
My question is how do edit the code to do the above but when the code finds an attachment is not available, ignores it and carries on adding the other attachments and displays the email for final checks
Here is the code
Sub SendPDFViaOutlook()
Dim StringTo As String, StringCC As String, StringBCC As String, Fname As String
Dim DefPath As String
Dim olApp As Object
Dim olMail As Object
Dim FileExtStr As String
If Len(ThisWorkbook.Path) = 0 Then
MsgBox "This macro will only work if the file is Saved once.", 48, "Mail PDF Outlook"
Exit Sub
End If
On Error Resume Next
wb2.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'Set reference to Outlook and turn off ScreenUpdating and Events
Set olApp = CreateObject("Outlook.Application")
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Set variables for parts of the email
'You may need to change these
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
StringTo = Sheets("Email Settings").Range("B2").Value
StringCC = Worksheets("Email Settings").Range("B4").Value
StringBCC = Worksheets("Email Settings").Range("B6").Value
StringSubject = Worksheets("Email Settings").Range("B13").Value
StringBody = Worksheets("Email Settings").Range("B16") & vbCr & vbCr & Worksheets("Email Settings").Range("B17") & vbCr & vbCr & Worksheets("Email Settings").Range("B18") & vbCr & vbCr & Worksheets("Email Settings").Range("B19") & vbCr & vbCr & Worksheets("Email Settings").Range("B20") & vbCr & vbCr & Worksheets("Email Settings").Range("B21") & vbCr & vbCr & Worksheets("Email Settings").Range("B22") & vbCr & vbCr & Worksheets("Email Settings").Range("B23").Value ' You can put a body here,
StringAttach = Worksheets("Settings").Range("B23").Value
StringAttach1 = Worksheets("Settings").Range("B78").Value
StringAttach2 = Worksheets("Settings").Range("B79").Value
StringAttach3 = Worksheets("Settings").Range("B80").Value
'Set email parts to variables
'On Error Resume Next
Set olMail = olApp.CreateItem(0)
With olMail
.To = StringTo
.CC = StringCC
.BCC = StringBCC
.Subject = StringSubject
.Body = StringBody
If StringAttach <> 0 Then .Attachments.Add StringAttach
If StringAttach <> 0 Then .Attachments.Add StringAttach1
If StringAttach <> 0 Then .Attachments.Add StringAttach2
If StringAttach <> 0 Then .Attachments.Add StringAttach3
.display
End With
End Sub
I hope I have added this code correctly.
Thanks in advance for help
Mark