Attaching Specific files to corresponding recipien

2019-04-17 01:50发布

问题:

I have a long list of cost reports to be sent to different recipients.

I was thinking I could have one Excel file with addresses and corresponding Location i.e A1 John.smith@com.com A2 0001 B1 Jeff.smith@com.com B1 0002

Then using VBA cycle through each row (1) and search a folder for the corresponding (A2) named file and attach it to mail out to cell (A1).

回答1:

I assume you have headers in the first row. Untested.

Sub AntMan()

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim lastRow As Long
Dim MailDest As String
Dim subj As String

lastRow = ThisWorkbook.WorkSheets("Sheet6").Cells(Rows.Count, "A").End(xlUp).Row 'change worksheet

For i = 2 To lastRow

    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
    Set Attach = OutLookMailItem.Attachments

    With OutLookMailItem
        .To = Cells(i, 1).Value
        .SUBJECT = "Put your subject here"
        .Body = "Put your body here"
        Attach.Add "C:\your\file\path\here\" & Cells(i, 2).Value & ".xlsx"
        .Display 'for debugging
        .Send
    End With

Next

End Sub