如何在 Excel VBA 中运行多个“For/Each”循环

Question

我正在从 excel 文档自动生成 VBA 电子邮件附件脚本。数据集是这样的

 File Name      Email     Body
 Sample 1       john@     Hello!
 Sample 2       mary @    Hello!

我正在尝试做的是告诉 excel 在“电子邮件”列下为每个人创建一封电子邮件，然后在电子邮件正文的“正文”列中写入文本，然后在“文件名”列下找到并附加一个文件名。所以 John@ 会收到一封正文为“你好！”的电子邮件。和示例 1 附件。

这将需要三个单独的循环，这让我感到困惑：

到目前为止，这是我的代码，但所做的只是找到附件：

Sub Attachment()


Dim colb As Range, mycell As Range, mycell2 As Range, mycell3 As Range
Set colb = Range(Range("B2"), Range("B2").End(xlDown))
Set colc = Range(Range("C2"), Range("C2").End(xlDown))
Set cold = Range(Range("D2"), Range("C2").End(xlDown))


For Each mycell In colb

Dim path As String
path = mycell.Value


Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    Set myAttachments = OutMail.Attachments

On Error Resume Next
With OutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Test"
    .Body = ""
    .Display
End With
On Error GoTo 0

myAttachments.Add "C:\R\" & path

Set OutMail = Nothing
Set OutApp = Nothing

Next

结束子

Answer 1

我不是 100% 确定您在说什么，因为我认为不需要 3 个循环。你不能只更新代码吗？

With OutMail
    .To = mycell.Offset(0, 1).Text
    .CC = ""
    .BCC = ""
    .Subject = "Test"
    .Body = mycell.Offset(0, 2).Text
    .Display
End With

这将引用并从 mycell 偏移以获取收件人和正文

在这种情况下，您可以将整个例程缩减为：

Sub Attachment()
Dim colb As Range, mycell As Range
Set colb = Range(Range("B2"), Range("B2").End(xlDown))
For Each mycell In colb
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    Set myAttachments = OutMail.Attachments
    On Error Resume Next
    With OutMail
        .To = mycell.Offset(0, 1).Text
        .Subject = "Test"
        .Body = mycell.Offset(0, 2).Text
        .Display
    End With
    myAttachments.Add "C:\R\" & mycell.Text
    Set OutMail = Nothing
    Set OutApp = Nothing
    Next
End Sub