vba - 使用 VBA 从 Excel 工作表发送多个附件

Question

我有现有代码可以从 Excel 文件中的工作表发送邮件 -

Sub CreateMail()

    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)

    Application.ScreenUpdating = False
    Worksheets("Mail List").Activate

    With ActiveSheet
        Set rngTo = .Range("B1")
        Set rngSubject = .Range("B2")
        Set rngBody = .Range("B3")
        Set rngAttach = .Range("B4")

    End With

    With objMail
        .To = rngTo.Value
        .Subject = rngSubject.Value
        .body = rngBody.Value
        .Attachments.Add rngAttach.Value
        .display 'Instead of .Display, you can use .Send to send the email _
                    or .Save to save a copy in the drafts folder
    End With

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

End Sub

但是，我想包含一些附件，因此 Set rngAttach = .Range("B4") 对此没有帮助。

对此有什么帮助吗？ 提前致谢!

Answer 1

将 .Attachments.Add 语句包含在循环中。像下面这样的东西可能会起作用

    For i = 4 To 6
      .Attachments.Add Range("B" & i).Value
    Next i