自动发送多封邮件并对应多份附件

Sub SendMail()
Dim outlookApp As Outlook.Application
Dim outlookItem As Outlook.MailItem
Dim i As Integer
Dim j As Integer
Dim p As String

i = Range("B2").End(xlDown).Row

For j = 1 To i

   If j > 1 Then

    Set outlookApp = New Outlook.Application
    Set outlookItem = outlookApp.CreateItem(olMailItem)

    p = Sheet1.Range("E" & j)

    On Error GoTo Sendmail_Error
        With outlookItem
             .To = Sheet1.Range("B" & j)
             .Subject = Sheet1.Range("C" & j)
             .body = Sheet1.Range("D" & j)
             .Attachments.Add p
             .Send
        End With
   End If
Next j

SendMail_Exit:
Exit Sub

Sendmail_Error:
MsgBox Err.Description
Resume SendMail_Exit
End Sub

转载于:https://blog.51cto.com/yueran/2363372