Adding multiple attachments based on cell values

[Shawn09]

Hello there!

I'm trying to modify an old macro I used from before but this time rather than just sending emails based on cell values and adding just one specific attachment, I'm needing it to add a different attachment to each of the emails. The code that I tried to modify just keeps giving me there error "Cannot find this file. Verify the path and file name are correct.". I know the path is correct so I'm assuming the issue is my method here... I'm not all that great in VBA... just dangerous enough to make things work occasionally. Here's what I have so far... any help would be greatly appreciated!:

<code>

Sub Send_Commission_Letter()

    Dim SendTo As String
    Dim SendCC As String
    Dim ToMSg As String
    Dim AddAttachment As String
 
    For i = 1 To 100
        SendTo = ThisWorkbook.Sheets(1).Cells(i, 3)
        SendCC = ThisWorkbook.Sheets(1).Cells(i, 5)
        AddAttachment = ThisWorkbook.Sheets(1).Cells(i, 6).Value
        If SendTo <> "" Then
            ToMSg = ThisWorkbook.Sheets(1).Cells(i, 7)
            Send_Commission_email SendTo, SendCC, AddAttachment, ToMSg
        End If
    Next i
End Sub

Sub Send_Commission_email(SendTo As String, SendCC As String, AddAttachment As String, ToMSg As String)

Sheets("SendMail").Select

Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim MyPath As String

MyPath = "C:\Users\Me\Desktop\filename.pdf"  'location of picture to be attached
Set olApp = CreateObject("Outlook.Application") 'reference to Outlook
Set olMail = olApp.CreateItem(olMailItem) 'reference to new email

With olMail
    .To = SendTo
    .CC = SendCC
    .Subject = Range("B3").Value
    .Body = ToMSg
    .Attachments.Add AddAttachment
    '.Attachments.Add MyPath
    .Display
    .Send
End With

    Set OutlookMail = Nothing
    Set OutlookApp = Nothing

End Sub
</code>

 

[Domenic]

Are you assigning both the path and filename to AddAttachment? If so, try this modified code for testing purposes only. It will loop through each row and check whether the path and filename exists. If it comes across one that doesn't exist, it will display a message saying so, and then exit the sub.

Sub Send_Commission_Letter()

    Dim SendTo As String
    Dim SendCC As String
    Dim ToMSg As String
    Dim AddAttachment As String
 
    For i = 1 To 100
        SendTo = ThisWorkbook.Sheets(1).Cells(i, 3)
        SendCC = ThisWorkbook.Sheets(1).Cells(i, 5)
        AddAttachment = ThisWorkbook.Sheets(1).Cells(i, 6).Value
        If Len(AddAttachment) > 0 Then
            If Len(Dir(AddAttachment, vbNormal)) = 0 Then
                MsgBox "The path and filename '" & AddAttachment & "' does not exist", vbExclamation
                Exit Sub
            End If
        End If
    Next i
End Sub

Does a message pop-up saying that a path and filename doesn't exist?

 

[Shawn09]

Thank you for the Reply! While I was trying to play around with your code, it actually helped identify a problem not with my code but with my worksheet. The code was showing the Column header as the file path instead of the actual cell containing the filepath and filename. Once I removed the header, the original code worked out great! Thanks again for your help though! If you know a way to avoid the issue of column headers, I'd definitely like to see a fix for that... for now I've just used a textbox as a column header. Thanks again!

 

[Domenic]

If the first row contains the column header, simply start your loop at the second row...

[COLOR=#333333]For i = [/COLOR][COLOR=#ff0000]2[/COLOR][COLOR=#333333] To 100[/COLOR]