0

我正在寻找一个 VBScript，它会使用邮件合并自动向我在 Excel 表格中的联系人列表中的每个人发送电子邮件。

任何帮助将不胜感激，如果您需要更多信息，请询问:)

基本上我有这个代码

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

     ' 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

     ' 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

但我需要它，而不是创建电子邮件，它使用邮件合并，并且电子邮件将发送给存储在 Excel 工作表中的列表中的每个人，问题是，我不知道如何做到这一点，所以任何帮助会很好！

谢谢

4

1 回答 1

1

这将向 Excel 文件中列出的每个人发送一封电子邮件。对于此示例，名称在 A 列中，电子邮件地址在 B 列中，主题在 C 列中。在草稿文件夹中创建一个模板并将主题设置为“模板”。在模板电子邮件中，在要替换为其他字段的任何字段周围使用 {}。在此示例中，{name} 被替换为 A 列中的名称。将 {image} 标记插入您希望图像所在的位置。我假设您想要相同的图像，因为它是公司徽标，因此您只需在 SendMessage Sub 中定义路径。这会将图像添加为附件，没有简单的方法可以解决这个问题，但它将嵌入到电子邮件的正文中。

set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Open ("H:\Book1.xls")
'skip header row. set to 1 if you
'don't have a header row
set sh = wb.Sheets("Sheet1")
row = 2
name = sh.Range("A" & row)
email = sh.Range("B" & row)
subject = sh.Range("C" & row)
'image = sh.Range("D" & row)
LastRow = sh.UsedRange.Rows.Count
For r = row to LastRow
    If App.WorkSheetFunction.CountA(sh.Rows(r)) <> 0 Then 
        SendMessage email, name, subject, TRUE, _
        NULL, "H:\Scripts\Batch\pic.png", 80,680
        row = row + 1
        name = sh.Range("A" & row)
        email = sh.Range("B" & row)
        subject = sh.Range("C" & row)
        'image = sh.Range("D" & row)
    End if
Next
wb.close
set wb = nothing
set app = nothing


Sub SendMessage(EmailAddress, DisplayName, Subject, DisplayMsg, AttachmentPath, ImagePath, ImageHeight, ImageWidth)

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

  template = FindTemplate()

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

  With objOutlookMsg
      ' Add the To recipient(s) to the message.
      Set objOutlookRecip = .Recipients.Add(EmailAddress)
      objOutlookRecip.resolve
      objOutlookRecip.Type = 1

     ' Set the Subject, Body, and Importance of the message.
     .Subject = Subject
     .bodyformat = 3
     .Importance = 2  'High importance
     body = Replace(template, "{name}", DisplayName)

     if not isNull(ImagePath) then
       if not ImagePath = "" then
         .Attachments.add ImagePath
         image = split(ImagePath,"\")(ubound(split(ImagePath,"\")))
         body = Replace(body, "{image}", "<img src='cid:" & image & _
         "'" & " height=" & ImageHeight &" width=" & ImageWidth & ">")
       end if
     else
        body = Replace(body, "{image}", "")
     end if

     if not isNull(AttachMentPath) then
       .Attachments.add AttachmentPath
     end if

     .HTMLBody = body

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

Function FindTemplate()
    Set OL = GetObject("", "Outlook.Application")
    set Drafts = OL.GetNamespace("MAPI").GetDefaultFolder(16)
    Set oItems = Drafts.Items

    For Each Draft In oItems
        If Draft.subject = "Template" Then
            FindTemplate = Draft.HTMLBody
            Exit Function
        End If
    Next
End Function
于 2013-05-30T18:26:27.820 回答