将附件添加到邮件合并到电子邮件

Question

我正在尝试创建邮件合并到电子邮件，这也会添加一个附件。我遵循文章中概述的步骤 http://word.mvps.org/FAQs/MailMerge/MergeWithAttachments.html

电子邮件已创建并发送到正确的电子邮件地址，但附件未被添加。我已经测试过它并且正在使用正确的文件名。

Sub emailmergewithattachments() 
Dim Source As Document, Maillist As Document, TempDoc As Document 
Dim Datarange As Range 
Dim i As Long, j As Long 
Dim bStarted As Boolean 
Dim oOutlookApp As Outlook.Application 
Dim oItem As Outlook.MailItem 
Dim mysubject As String, message As String, title As String 
Set Source = ActiveDocument 
' Check if Outlook is running. If it is not, start Outlook 
On Error Resume Next 
Set oOutlookApp = GetObject(, "Outlook.Application") 
If Err <> 0 Then 
    Set oOutlookApp = CreateObject("Outlook.Application") 
    bStarted = True 
End If 
' Open the catalog mailmerge document 
With Dialogs(wdDialogFileOpen) 
    .Show 
End With 
Set Maillist = ActiveDocument 
' Show an input box asking the user for the subject to be inserted into the email messages 
message = "Enter the subject to be used for each email message." ' Set prompt. 
title = " Email Subject Input" ' Set title. 
' Display message, title 
mysubject = InputBox(message, title) 
' Iterate through the Sections of the Source document and the rows of the catalog mailmerge document, 
' extracting the information to be included in each email. 
For j = 1 To Source.Sections.Count - 1 
    Set oItem = oOutlookApp.CreateItem(olMailItem) 
    With oItem 
     .Subject = mysubject 
     .Body = Source.Sections(j).Range.Text 
     Set Datarange = Maillist.Tables(1).Cell(j, 1).Range 
     Datarange.End = Datarange.End - 1 
     .To = Datarange 
     For i = 2 To Maillist.Tables(1).Columns.Count 
      Set Datarange = Maillist.Tables(1).Cell(j, i).Range 
      Datarange.End = Datarange.End - 1 
      .Attachments.Add Trim(Datarange.Text), olByValue, 1 
     Next i 
     .Send 
    End With 
    Set oItem = Nothing 
Next j 
Maillist.Close wdDoNotSaveChanges 
' Close Outlook if it was started by this macro. 
If bStarted Then 
    oOutlookApp.Quit 
End If 
MsgBox Source.Sections.Count - 1 & " messages have been sent." 
'Clean up 
Set oOutlookApp = Nothing 
End Sub 

Answer 1

最有可能的，我猜这是你的问题

.Attachments.Add TRIM（Datarange.Text），olByValue，1

是Datarange.Text等于完整路径文件并确实存在该文件？