在VBA中使用带附件的范围发送多封电子邮件

debugcn 发表于 Dev

先生

这是我第一次尝试从 Excel 使用 VBA 代码发送电子邮件。

这是我的 Excel 结构。有时电子邮件列表也会有 1 - 20 个或只有 1 个

A (col) B          C         D        E     F              G
Sl.No  First Name To Email  CC Email Subj   File to Send   Message

代码：

Option Explicit

Sub SendMail()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With ActiveSheet
Set rngTo = .Range("C2")
Set rngSubject = .Range("E2")
Set rngBody = .Range("G2")
Set rngAttach = .Range("F2")
End With

With objMail
    .To = rngTo.Value
    .Subject = rngSubject.Value
    .Body = rngBody.Value
    .Attachments.Add rngAttach.Value
    .Display

End With

Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing
End Sub

这是我的代码，它运行良好，但对于发送单个电子邮件，但不适用于多个电子邮件。

我在这里苦苦寻找如何使用经过测试的代码发送带有附件的多封电子邮件。

米库

也许试试这个：

Option Explicit

Sub SendMail()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range
Dim i As Integer

Set objOutlook = CreateObject("Outlook.Application")


For i = 2 To 21 ' Loop from 2 to 21


    With ActiveSheet
    Set rngTo = .Range("C" & i)
    Set rngSubject = .Range("E" & i)
    Set rngBody = .Range("G" & i)
    Set rngAttach = .Range("F" & i)
    End With

    Set objMail = objOutlook.CreateItem(0)

    With objMail
        .To = rngTo.Value
        .Subject = rngSubject.Value
        .HTMLBody = "<B><U>" & rngBody.Value & ":</B></U>"
        .Attachments.Add rngAttach.Value
        .Display

    End With

    Set objMail = Nothing

Next

Set objOutlook = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing
End Sub

您可以循环遍历 Range 以生成 20 封电子邮件。

更新