邮件合并求助：发送不同附件

蓝色简宁

达人们：
我想要给每个人发的Email开头都附上其姓名，并且挂上相应的邮件合并后的附件。如何实现啊？目前看帖子下来，只能实现邮件合并的邮件正文带上相同的附件，或是相同的邮件内容带上邮件合并后不同的附件。但二者都是邮件合并的产物，好像没人提到。
有没有高手能指点一下迷津。。。大谢！！{:soso_e100:}

413191246se

如果是网易邮箱，问网易去！如果是新浪邮箱，问新浪去！如果是搜狐邮箱，问搜狐去！……

蓝色简宁

413191246se 发表于 2012-3-28 11:24
如果是网易邮箱，问网易去！如果是新浪邮箱，问新浪去！如果是搜狐邮箱，问搜狐去！……

你还有够无聊。。。

06101403

路过 学习了....

413191246se

谢谢楼主！不是我无聊，我说的是事实（幸好楼主没骂我，挺有修养的，3Q！）。我针对的是你第一个问题回答的，确实是认真在回答，没有戏耍楼主。

Levyna

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

MáοMáο゛趙

Levyna 发表于 2015-12-21 15:24
Sub emailmergewithattachments()
Dim Source As Document, Maillist As Document, TempDoc As Document
...

这个实际要怎么操作呀，小白一个，求指教