How can I ignore an email attachment if missing from folder

MFChuckee · Jan 15th 2021

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

rollis13 · Jan 15th 2021

All you need to do is add a Function that will check if your file exists. Change your macro like this and add the Function (it's at the bottom).

Code

Option Explicit
Sub SendPDFViaOutlook()
    Dim StringTo As String, StringCC As String, StringBCC As String', Fname As String '<=changed
    Dim StringSubject As String, StringBody As String    '<= added
    Dim StringAttach, StringAttach1, StringAttach2, StringAttach3    '<= added
    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
'=================== Is this part necessary ========================
'    On Error Resume Next
'    Dim wb2
'    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
'============ changed ============
        If StringAttach <> 0 Then
            If FileExists(StringAttach) Then .Attachments.Add StringAttach
            If FileExists(StringAttach1) Then .Attachments.Add StringAttach1
            If FileExists(StringAttach2) Then .Attachments.Add StringAttach2
            If FileExists(StringAttach3) Then .Attachments.Add StringAttach3
        End If
'============= end ===============
        .Display
    End With
End Sub

Function FileExists(ByVal FileName As String) As Boolean
    FileExists = (Dir(FileName) <> "")
End Function

Display More

MFChuckee · Jan 15th 2021

rollis13

Thanks for the code. Didn't think anyone was going to reply to my request

This works a treat thanks. .

I did look at the FileExists method before but couldn't get it to work.

Also you were right with the section "======Is this part necessary =====" which wasn't.

It was left over from some earlier incarnation of this code and I hadn't removed it.

Thanks again

Mark

rollis13 · Jan 15th 2021

I'm glad I've been of some help.

Well, sometimes it even takes more than 4 hours to have a reply (if any) .

How can I ignore an email attachment if missing from folder

Participate now!

Share

Tags