Excel – Sending Multiple emails with Different Attachments

emailexcelvba

I am trying to send emails to a list of recipients in an Excel spreadsheet, with a different attachment for each of the emails.

I created a macro that generates the different emails, but when I added attachments, only the first email of the list is created with the correct attachment.

When the loop comes back to the second email it gives me an error message saying that the attachment was not found (I assume this is for the second message).

I checked and the file names and paths are correct according to the rules I set in the code. It doesn't create a draft of the second email, but simply tells me the file was not found.

How can I generate all of the emails with their proper attachments?

The code is as follows:

Sub clientemails()

Dim pfolio As String
Dim destino As String
Dim mo As String
Dim text As String
Dim subject As String
Dim CC As String
Dim signature As String
Dim officer As String
Dim yr As String
Dim date1 As String
Dim position As String
Dim analysis As String
Dim activities As String

Dim nl As Integer
Dim i As Integer

Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.mailitem

Set OutlookApp = New Outlook.Application

nl = Cells(5, 1).End(xlDown).Row
i = 5

yr = Cells(1, 6).Value
date1 = Format(Cells(1, 4).Value, "mm.dd.yy")

While nl + 1 > i

    pfolio = Cells(i, 2).Value
    destino = Cells(i, 3).Value
    officer = Cells(i, 10).Value
    CC = Cells(i, 11).Value

    Set MItem = OutlookApp.CreateItem(olmailitem)

    If Cells(i, 9) = "P" Then

        mo = Cells(1, 3)
        subject = "Posição e Análise " & pfolio
        text = "<p><font face=arial size=3>Bom Dia,</p>" _
          & "<p>Segue em anexo a posição e análise da carteira " & pfolio & " referente ao mês de " & mo & ". Caso tenha quaisquer dúvidas, favor entrar em contato conosco.</p>" _
          & "Atenciosamente,"

    ElseIf Cells(i, 9) = "E" Then

        month = Cells(2, 3)
        subject = pfolio & " Statement and Analysis"
        text = "<p><font face=arial size=3>Hello,</p>" _
          & "<p>Please find attached the portfolio statement and analysis for the " & pfolio & " portfolio for the month of " & mo & ". Should you have any questions, please don't hesitate to contact us.</p>" _
          & "Sincerely,"
    End If

    If Cells(i, 4) = "X" Then

        position = "F:\Files\General Folders\3 Clients\" & officer & "\" & pfolio & "\Position\" & yr & "\" & pfolio & " Portfolio Statement Summary " & date1 & ".pdf"
        With MItem
            .Attachments.Add position
        End With

    End If

    If Cells(i, 5) = "X" Then

        analysis = "F:\Files\General Folders\3 Clients\" & officer & "\" & pfolio & "\Portfolio Analysis\" & yr & "\" & pfolio & " Portfolio Analysis " & date1 & ".pdf"
        With MItem
            .Attachments.Add analysis
        End With

    End If

    If Cells(i, 6) = "X" Then

        activities = "F:\Files\General Folders\3 Clients\" & officer & "\" & pfolio & "\Portfolio Activities\" & yr & "\" & pfolio & " Portfolio Activities " & date1 & ".pdf"
        With MItem
            .Attachments.Add activities
        End With

    End If

    With MItem
        .Display
    End With

    signature = MItem.HTMLBody

    With MItem
        .subject = subject
        .To = destino
        .CC = CC
        .HTMLBody = text & signature
        .Save
    End With

    i = i + 1

Wend

End Sub

Best Answer

I understand you are supposed to save your mail item before adding attachments. So you might need

MItem.SaveAs('some path name', olTXT)

before you add each attachment.

EDIT: Or perhaps it's best to simply use

MItem.Save
Related Topic