VBA Code / File not found error

[ADSkinner]

Hello. I have a VBA that is pulling files out of excel and creating emails. I have an extensive master list with potential files, which may or may not be found on a given week. My issue is, when it runs, if it cannot find one of the files, then the module stops.

Is there a way that if a file is not found, it can move onto the next one and so on and so forth without stopping? Here is my code:

Sub SendMultipleEmails()


Dim Mail_Object, OutApp As Variant




 With ActiveSheet
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With


For i = 2 To lastrow


Set Mail_Object = CreateObject("Outlook.Application")
Set OutApp = Mail_Object.CreateItem(0)


    With OutApp
    .Subject = "Open Order Report - " & Cells(i, 4).Value & " - " & Date
    Dim sMsgBody As String


.Body = "Hello " & Cells(i, 1).Value & "," & vbCr & vbCr
.Body = .Body & "Could you please provide a delivery schedule/status for the attached:" & vbCr & vbCr
.Body = .Body & "'OK if the date is acceptable in the 'STATUS/Long Text' field, or specify date in which you will ship - in the 'Committed Supplier Reschedule Date" & vbCr & vbCr
.Body = .Body & "Any additional comments can be added to the 'STATUS/Long Text' field. " & vbCr & vbCr
.Body = .Body & "Thank you, and have a great day!" & vbCr & vbCr


.Body = .Body


    .To = Cells(i, 2).Value
    .Attachments.Add Cells(i, 3).Value
    .Send
    End With
   


Next i


debugs:
If Err.Description <> "" Then MsgBox Err.Description






End Sub

 

[Leith Ross]

Hello ADSkinner,

This version of your macro tests if the file exists before adding it as an attachment.

Sub SendMultipleEmails()


    Dim File        As String
    Dim OutApp      As Object
    Dim sMsgBody    As String


        With ActiveSheet
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With


        Set OutApp = CreateObject("Outlook.Application")
        
        For i = 2 To lastrow
            With OutApp.CreateItem(0)
                .Subject = "Open Order Report - " & Cells(i, 4).Value & " - " & Date
                .Body = "Hello " & Cells(i, 1).Value & "," & vbCr & vbCr
                .Body = .Body & "Could you please provide a delivery schedule/status for the attached:" & vbCr & vbCr
                .Body = .Body & "'OK if the date is acceptable in the 'STATUS/Long Text' field, or specify date in which you will ship - in the 'Committed Supplier Reschedule Date" & vbCr & vbCr
                .Body = .Body & "Any additional comments can be added to the 'STATUS/Long Text' field. " & vbCr & vbCr
                .Body = .Body & "Thank you, and have a great day!" & vbCr & vbCr
                .To = Cells(i, 2).Value
                File = Dir(Cells(i, 3))
                If File <> "" Then .Attachments.Add File
                .Send
            End With
        Next i


End Sub

 

[ADSkinner]

Thank you Leith, it does test if the file exists, however if the file cannot be located, then the module stops at the portion below and will not continue to run to the next file that does exist

If File <> "" Then .Attachments.Add File

 

[Leith Ross]

Hello ADSkinner,

That was not what I expected. Okay, let's do this...

Sub SendMultipleEmails()


    Dim OutApp      As Object
    Dim sMsgBody    As String


        With ActiveSheet
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With


        Set OutApp = CreateObject("Outlook.Application")
        
        For i = 2 To lastrow
            With OutApp.CreateItem(0)
                .Subject = "Open Order Report - " & Cells(i, 4).Value & " - " & Date
                .Body = "Hello " & Cells(i, 1).Value & "," & vbCr & vbCr
                .Body = .Body & "Could you please provide a delivery schedule/status for the attached:" & vbCr & vbCr
                .Body = .Body & "'OK if the date is acceptable in the 'STATUS/Long Text' field, or specify date in which you will ship - in the 'Committed Supplier Reschedule Date" & vbCr & vbCr
                .Body = .Body & "Any additional comments can be added to the 'STATUS/Long Text' field. " & vbCr & vbCr
                .Body = .Body & "Thank you, and have a great day!" & vbCr & vbCr
                .To = Cells(i, 2).Value
                On Error Resume Next
                    .Attachments.Add Cells(i, 3).Value
                On Error GoTo 0
                .Send
            End With
        Next i


End Sub

 

[ADSkinner]

Leith...Okay, now that code worked and it did not stop or error out upon coming to a file that does not exist.

However.... (almost there)

It sent an email for every entry, whether there was an attachment found or no attachment. I was hoping that it would only send those emails to which it has a valid attachment. Those that do not have the attachment in that specific folder, I would hope that it would simply skip and move onto the next one that did.

Is that possible?

Thank you again for all of your help.

 

[Leith Ross]

Hello ADSkinner,

Third time is the charm. This will not send an email if the file does not exist.

Sub SendMultipleEmails()


    Dim File        As String
    Dim OutApp      As Object
    Dim sMsgBody    As String


        With ActiveSheet
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With


        Set OutApp = CreateObject("Outlook.Application")
        
        For i = 2 To lastrow
            File = Dir(Cells(i, 3))
            If File <> "" Then
                With OutApp.CreateItem(0)
                    .Subject = "Open Order Report - " & Cells(i, 4).Value & " - " & Date
                    .Body = "Hello " & Cells(i, 1).Value & "," & vbCr & vbCr
                    .Body = .Body & "Could you please provide a delivery schedule/status for the attached:" & vbCr & vbCr
                    .Body = .Body & "'OK if the date is acceptable in the 'STATUS/Long Text' field, or specify date in which you will ship - in the 'Committed Supplier Reschedule Date" & vbCr & vbCr
                    .Body = .Body & "Any additional comments can be added to the 'STATUS/Long Text' field. " & vbCr & vbCr
                    .Body = .Body & "Thank you, and have a great day!" & vbCr & vbCr
                    .To = Cells(i, 2).Value
                    .Attachments.Add File
                    .Send
                End With
            End If
        Next i


End Sub

 

[ADSkinner]

This time, it gave me an error on the line '.Attachments.Add File'. I am guessing when it cannot find the file?

I see that you changed the code a bit from the attachment portion, would this be causing that error?

 

[Leith Ross]

Hello ADSkinner,

I was out of my office. The code in this last macro first tests if the file exists and if it does then the email is created and sent. If the file is not found the email is never even created. I cannot explain why you are receiving an error with this last macro.

 

[ZVI]

If path is expected in the cells then what was used previously should work:
.Attachments.Add Cells(i, 3).Value
Path does not exist in the File variable here.

 

[ADSkinner]

Leith,
The 3rd time was the charm. I modified the line '.Attachments.Add File' to read '.Attachments.Add Cells(i, 3).Value' and now it works perfectly. Thank you for all your help!!!