如何将附件添加到电子邮件中并从excel发送到多个附件

Question

我找到了下面的脚本here

    Sub emailtest()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With ActiveSheet
Set rngTo = .Range("E2")
Set rngSubject = .Range("E3")
Set rngBody = .Range("E4")
End With

With objMail
.To = rngTo.Value
.Subject = rngSubject.Value
.Body = rngBody.Value
.Attachments.Add "Z:\PHS 340B\Letters of Non-Compliance\..Resources\W9 Form\VPNA W-9 01 09 2017"
.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

End Sub

我将Set rngTo = .Range("E2")改为rngTo = .Range("G8:G38")，运行了脚本:.to = rngTo.Value上出现了440个错误

我做错了什么？

Answer 1

蒂姆上面说的话。尝尝这个。

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim emails as string
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With ActiveSheet
Set rngTo = .Range("G8:G38")
Set rngSubject = .Range("E3")
Set rngBody = .Range("E4")
End With

For Each E In rngTo
    emails = emails & E & ";"
Next

With objMail
.To = emails
.Subject = rngSubject.Value
.Body = rngBody.Value
'.Attachments.Add "Z:\PHS 340B\Letters of Non-Compliance\..Resources\W9 Form\VPNA W-9 01 09 2017"
.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