如何循环发送电子邮件

时间:2014-02-24 16:59:22

标签: vba email

我有一个文件夹test,其中包含以下文件user1.xlsx , user2.xlsx , user3.xlsx 在我的工作电子表格work.xlsx中,我有相应的地址

user1.xlsx  user1name@gmail.com
user2.xlsx  user2name@yahoo.com
 ...

如何将附带user1,user2 .xlsx文件的电子邮件发送到相应的电子邮件

'Email
Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = userVar
        .SentOnBehalfOfName = "xxxx"
        .CC = ""
        .BCC = ""
        .Subject = "...
        .Body = "...
        .Attachments. .. ??
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing


'Close

1 个答案:

答案 0 :(得分:5)

您是否查看了this MS KB?它详细说明了发送电子邮件的VBA如下:

Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
      Dim objOutlook As Outlook.Application
      Dim objOutlookMsg As Outlook.MailItem
      Dim objOutlookRecip As Outlook.Recipient
      Dim objOutlookAttach As Outlook.Attachment

      ' Create the Outlook session.
      Set objOutlook = CreateObject("Outlook.Application")

      ' Create the message.
      Set objOutlookMsg  = objOutlook.CreateItem(olMailItem)

      With objOutlookMsg
          ' Add the To recipient(s) to the message.
          Set objOutlookRecip = .Recipients.Add("Nancy Davolio")
          objOutlookRecip.Type = olTo

          ' Add the CC recipient(s) to the message.
          Set objOutlookRecip = .Recipients.Add("Michael Suyama")
          objOutlookRecip.Type = olCC

         ' Add the BCC recipient(s) to the message.
          Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
          objOutlookRecip.Type = olBCC

         ' Set the Subject, Body, and Importance of the message.
         .Subject = "This is an Automation test with Microsoft Outlook"
         .Body = "This is the body of the message." &vbCrLf & vbCrLf
         .Importance = olImportanceHigh  'High importance

         ' Add attachments to the message.
         If Not IsMissing(AttachmentPath) Then
             Set objOutlookAttach = .Attachments.Add(AttachmentPath)
         End If

         ' Resolve each Recipient's name.
         For Each ObjOutlookRecip In .Recipients
             objOutlookRecip.Resolve
         Next

         ' Should we display the message before sending?
         If DisplayMsg Then
             .Display
         Else
             .Save
             .Send
         End If
      End With
      Set objOutlook = Nothing
  End Sub

请注意,您必须使用 AttachmentPath 设置 objOutlookAttach ,这与文件的位置相同(硬编码或use current directory as path)。您的循环应该是指定范围内的每个电子邮件地址,获取相应的文件名(来自相邻单元格),将其附加到AttachmentPath变量,然后用于设置objOutlookAttach。

更新:可以找到更新,相关的MS文章here,以获取更多参考和指导。