Loop through documents to attach one per email with email subject based on document name

Question

I created a macro to send multiple invoices, one per email. I need the email subject to be a part of the file name.

It worked with the first file but then it takes that as fixed. I tried to Do While with the second variable (file1) but didn't work.

File name for reference: US21_US61_0000_6460069666_YBF2_6203963322_ZB34_00_0

Sub todo()

'Outlook should be opened

Dim OutApp As Object
Dim OutMail As Object

'Opens APP Outlook
Set OutApp = CreateObject("Outlook.Application")

On Error Resume Next

    'Improve performance
    Application.ScreenUpdating = True  

    'Path from the computer where it is used
    mypath = "C:\Users\natudiaz\Downloads\Invoices\US\"

    'Takes files from extension consider pdf or excel
    myfile = Dir(mypath & "*.pdf*")

    myfile1 = Mid(myfile, 16, 10)

    Do While myfile <> ""

        'Makes iterations
        
        'Creates email
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .To = "natudiazci@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "INV:" + myfile1
            .Body = "To the Team"
            .Attachments.Add (mypath + myfile)
            .Display
            .Send
            .ReadReceiptRequested = True
        End With

        'Next

        myfile = Dir

    Loop
    
    Application.ScreenUpdating = False

End Sub

`On Error Resume Next` hides errors. It is used incorrectly 99.9999% of the time. https://stackoverflow.com/questions/31753201/vba-how-long-does-on-error-resume-next-work/31753321#31753321 — niton, Feb 15 '23 at 01:55

score 0 · Answer 1 · answered Feb 14 '23 at 15:51

0

This

myfile1 = Mid(myfile, 16, 10)

Should go inside the do loop, not outside, as outside is only calculated for the first file.

answered Feb 14 '23 at 15:51

wrbp

870
1
3
9

score 0 · Accepted Answer · answered Feb 14 '23 at 22:14

That is because you get the file name for the subject once and then iterate over all files. But instead, you need to get the file name for the subject line in the loop with creating emails.

      Do While myfile <> ""

        myfile1 = Mid(myfile, 16, 10)
        
        'Makes iterations
        'Creates email
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "natudiazci@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "INV:" + myfile1
            .Body = "To the Team"
            .Attachments.Add (mypath + myfile)
            .ReadReceiptRequested = True 
            .Send
        End With
        'Next
        myfile = Dir
    Loop

Note, I've removed the Display call which is not required if you send items immediately. Also I've moved the ReadReceiptRequested property before the Send call. No actions should be taken on the submitted item.

Loop through documents to attach one per email with email subject based on document name

2 Answers2