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()
' 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
you need to return the result property of the mailmerge field, but i do not see from the above how to identify the correct field
if you post a sample document someone may be able to identify the correct field
some of us can only open .doc files, so if using later versions of word saveAs earlier version
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
as this is often the case, note i said SAMPLE, no need to post real data
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
For Each subdoc In doc.Subdocuments
Set newdoc = subdoc.Open
'Remove NextPage section breaks
'originating from mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
addr = .tables(1).Cell(13, 2).Range.Text
addr = left(addr, len(addr) - 1)
.SaveAs FileName:="MergeResult" & addr & ".doc"
.Close
End With
docCounter = docCounter + 1
Next subdoc
note the @ character may not be valid in filenames and may need to be replaced
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
I tried that and now i am getting runtime error 424 object required
on which line?
the only thing i can see is if some subdoc does not contain a table
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
it does not require that part at all, remove the 3 lines
For i = 1 To oblist.Tables(1).Rows.Count
Set DocName = oblist.Tables(1).Cell(i, 1).Range
DocName.End = DocName.End - 1
then try again to see what other bits need fixing
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Reply With Quote
