邮件合并VBA帮助 [英] Mail Merge VBA help
问题描述
大家好，
我有以下代码，我想知道是否可以从每个文档中的一个字段中保存每个项目？我在邮件合并文档中有一个电子邮件地址字段，我希望在保存
时将其用作文档名称。到目前为止，这是我的代码。我没有必要更改saveas部分指向文档中的内容但不知道如何让它查看每个邮件合并文档并拉出我们的电子邮件地址字段并将其用作saveas行的一部分...谢谢for
looking。
I have the following peice of code and was wondering is there anyway i can get each item to be saved from one the fields within each document? I have an email address field in the mail merge document that i would like to be used as the document name when saved. Here is my code so far. I no i have to change the saveas part to point to something in the document but not sure how to get it to look at each mail merge document and pull our the email address field and use it as part of the saveas line...Thanks for looking.
Sub SaveRecsAsFiles（）
'将所有部分转换为Subdocs $
AllSectionsToSubDoc ActiveDocument
'将每个Subdoc保存为单独的文件
SaveAllSubDocs ActiveDocument
结束子
Sub AllSectionsToSubDoc（ByRef doc As Word.Document）
Dim secCounter As Long
Dim NrSecs As Long
NrSecs = doc.Sections.Count
'从最后开始，因为创建
'Subdocs插入额外的部分
对于secCounter = NrSecs - 1到1步-1
doc.Subdocuments.AddFromRange _
doc.Sections（secCounter）.Range
Next secCounter
End Sub
Sub SaveAllSubDocs（ByRef doc As Word.Document）
Dim subdoc As Word.Subdocument
Dim newdoc As Word.Document
Dim docCounter作为Long
docCounter = 1
'必须在MasterView中使用
'Subdocs作为单独的文件
doc.ActiveWindow.View = wdMasterView
For i = 1 to oblist.Tables（1）.Rows.Count
Set DocName = oblist.Tables（1）.Cell（ i，1）.Range
DocName.End = DocName.End - 1
For docs in doc.Subdocuments
设置newdoc = subdoc.Open
'删除NextPage分节符来源$ mail
'来自mailmerge
RemoveAllSectionBreaks newdoc
使用newdoc
.SaveAs FileName：=" MergeResult" &安培; CStr（docCounter）
。关闭
结束与
docCounter = docCounter + 1
下一个子目录
结束子
Sub RemoveAllSectionBreaks（doc As Word.Document）
使用doc.Range.Find
.ClearFormatting
.Text =" ^ b"
使用.Replacement
.ClearFormatting
.Text =""
结束与
。执行替换：= wdReplaceAll
结束与
结束子
Sub SaveRecsAsFiles()
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
End Sub
Sub AllSectionsToSubDoc(ByRef doc As Word.Document)
Dim secCounter As Long
Dim NrSecs As Long
NrSecs = doc.Sections.Count
'Start from the end because creating
'Subdocs inserts additional sections
For secCounter = NrSecs - 1 To 1 Step -1
doc.Subdocuments.AddFromRange _
doc.Sections(secCounter).Range
Next secCounter
End Sub
Sub SaveAllSubDocs(ByRef doc As Word.Document)
Dim subdoc As Word.Subdocument
Dim newdoc As Word.Document
Dim docCounter As Long
docCounter = 1
'Must be in MasterView to work with
'Subdocs as separate files
doc.ActiveWindow.View = wdMasterView
For i = 1 To oblist.Tables(1).Rows.Count
Set DocName = oblist.Tables(1).Cell(i, 1).Range
DocName.End = DocName.End - 1
For Each subdoc In doc.Subdocuments
Set newdoc = subdoc.Open
'Remove NextPage section breaks
'originating from mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:="MergeResult" & CStr(docCounter)
.Close
End With
docCounter = docCounter + 1
Next subdoc
End Sub
Sub RemoveAllSectionBreaks(doc As Word.Document)
With doc.Range.Find
.ClearFormatting
.Text = "^b"
With .Replacement
.ClearFormatting
.Text = ""
End With
.Execute Replace:=wdReplaceAll
End With
End Sub
邮件合并字段希望用作名称是电子邮件地址
The mail merge field is want to be used as the name is e-mail address
谢谢
推荐答案
看看 -
http://www.gmayor.com/individual_merge_letters.htm 和
http://www.gmayor.com/ManyToOne.htm 这两个都可以满足您的需求。如果你想单独行动，第一个链接底部有一些宏代码指明了前进的方向。
Take a look at - http://www.gmayor.com/individual_merge_letters.htm and http://www.gmayor.com/ManyToOne.htm both of which will do what you want. There is some macro code at the bottom of the first link that points a way forward if you want to go it alone.
这篇关于邮件合并VBA帮助的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
