jbndylan
08-18-2015, 05:14 AM
Since I'm new to this, I'm hoping someone can point me in the right location.
I'm trying to create a macro that takes the merged document and renames each page (Letter) separately and uses a merged field in the letter as part of the filename. I completed one before that used a footer but the header and footer in the mail merge template will not allow it. Below is my code so far. . .
Sub PVOHLetterSave11()
Dim fname As MailMergeDataField
Dim StrName As String
' Used to set criteria for moving through the document by section.
Application.Browser.target = wdBrowseSection
With ActiveDocument
StrFolder = .path & Application.PathSeparator
'A mailmerge document ends with a section break next page.
For i = 1 To .MailMerge.DataSource.RecordCount
Set fname = ActiveDocument.MailMerge(i).DataFields("MASTER_VENDOR_MNEMONIC").Range
fname.End = fname.End - 1
dt = Format(CStr(Now), "mmddyyy")
If Trim(.DataFields("MASTER_VENDOR_MNEMONIC")) = "" Then Exit For
StrName = .DataFields("MASTER_VENDOR_MNEMONIC") & "_" & dt
' Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "\\vcuhshmo\groups\Claims Administration\CCU\PVOH\PVOH Mail Merge Letters"
docnum = docnum + 1
ActiveDocument.SaveAs fileName:=StrName.Text & ".docx"
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
ActiveDocument.path & "\" & ActiveDocument.Name & ".pdf", ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveDocument.Close
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
I'm trying to create a macro that takes the merged document and renames each page (Letter) separately and uses a merged field in the letter as part of the filename. I completed one before that used a footer but the header and footer in the mail merge template will not allow it. Below is my code so far. . .
Sub PVOHLetterSave11()
Dim fname As MailMergeDataField
Dim StrName As String
' Used to set criteria for moving through the document by section.
Application.Browser.target = wdBrowseSection
With ActiveDocument
StrFolder = .path & Application.PathSeparator
'A mailmerge document ends with a section break next page.
For i = 1 To .MailMerge.DataSource.RecordCount
Set fname = ActiveDocument.MailMerge(i).DataFields("MASTER_VENDOR_MNEMONIC").Range
fname.End = fname.End - 1
dt = Format(CStr(Now), "mmddyyy")
If Trim(.DataFields("MASTER_VENDOR_MNEMONIC")) = "" Then Exit For
StrName = .DataFields("MASTER_VENDOR_MNEMONIC") & "_" & dt
' Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "\\vcuhshmo\groups\Claims Administration\CCU\PVOH\PVOH Mail Merge Letters"
docnum = docnum + 1
ActiveDocument.SaveAs fileName:=StrName.Text & ".docx"
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
ActiveDocument.path & "\" & ActiveDocument.Name & ".pdf", ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveDocument.Close
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub