Mail merge printing without header/footer

[Bratone]

Hello, I am trying to run a macro in order to print my files from a mail merge to individual word files and I am using the following code that I have found online:


Option Explicit

Const FOLDER_SAVED As String = "C:\Users\cbuja\Desktop\test\"
Const SOURCE_FILE_PATH As String = "C:\Users\cbuja\Desktop\februarie wk9.xlsm"


Sub TestRun()
Dim MainDoc As Document, TargetDoc As Document
Dim dbPath As String
Dim recordNumber As Long, totalRecord As Long


Set MainDoc = ActiveDocument
With MainDoc.MailMerge

'// if you want to specify your data, insert a WHERE clause in the SQL statement
.OpenDataSource Name:=SOURCE_FILE_PATH, SQLStatement:="SELECT * FROM [Sheet1$]"

totalRecord = .DataSource.RecordCount


For recordNumber = 1 To totalRecord

With .DataSource
.ActiveRecord = recordNumber
.FirstRecord = recordNumber
.LastRecord = recordNumber
End With

.Destination = wdSendToNewDocument
.Execute False

Set TargetDoc = ActiveDocument


TargetDoc.SaveAs2 FOLDER_SAVED & "Batch Disposition Checklist " & .DataSource.DataFields("Batch_Number").Value & " (RRPPMR)" & ".docx", wdFormatDocumentDefault

TargetDoc.Close False

Set TargetDoc = Nothing

Next recordNumber


End With


Set MainDoc = Nothing
End Sub

The problem is that the files are printed without the header and the footer. Is there any way to solve this please ? I looked at other tutorials online but I am really new to this VBA stuff and I can't seem to make it work, modifying anything in the code just gives me tons of errors and it's not working anymore.

Thanks for your help !

[macropod]

Why are you trying to merge to individual files if all you want is a printout? If you need both, see Send Mailmerge Output to Individual Files at: Mailmerge Tips & Tricks (msofficeforums.com) (https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html)
all you'd need do is insert:
.Printout
before:
.SaveAs
or:
.Close SaveChanges:=False

[Bratone]

Maybe I explained it wrongly, I need to save each file individually after I merge them.


all you'd need do is insert:
.Printout
before:
.SaveAs
or:
.Close SaveChanges:=False

You mean to do this in my code or in the code from the link above ?
Thanks.

[macropod]

You mean to do this in my code or in the code from the link above ?
The code in the link.

[Bratone]

Using printout I'm getting the files as PDF and not as Word, am I using it wrong or it's not possible to have it as word using this function ?

[macropod]

That's only because you have set your system's printer to be a DPF printer...

[Bratone]

Thank you but that's because it's the first time when I am using VBA and I am using a code that I copied from the internet and that I'm trying to fix it by myself without any VBA knowledge what so ever.

I actually managed to use the code from the link that you provided and modify it in a way that it doesn't give me tons of errors but I got the same results, it saves files without Header/Footer.

This is the code that I modified, obviously the name of the files that are generated are a mess but I didn't manage to save them with the name that I wanted without receiving errors:


Sub Merge_To_Individual_Files()' Sourced from: https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
Const StrNoChr As String = """*./\:?|"
Set MainDoc = ActiveDocument
With MainDoc
StrFolder = .MailMerge.DataSource.Name
i = InStrRev(StrFolder, "\")
StrFolder = Left(StrFolder, i)
With .MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
On Error Resume Next
For i = 1 To .DataSource.RecordCount
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
If Trim(.DataFields("Batch_Number")) = "" Then Exit For
StrName = .DataFields("Batch_Number") & "_" & .DataFields("PO")
End With
On Error GoTo NextRecord
.Execute Pause:=False
For j = 1 To Len(StrNoChr)
StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
Next
StrName = Trim(StrName)
With ActiveDocument
'Add the name to the footer
.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
.SaveAs FileName:=StrFolder & StrName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
.Close SaveChanges:=False
End With
NextRecord:
Next i
End With
End With
Application.ScreenUpdating = True
End Sub




So same results with this one, no Header/Footer ...

[macropod]

If your mailmerge main document has a header and/or footer, it is simply not possible for the macro to not include those. I have confirmed that in testing. The only difference is that your implementation of the code inserts StrName into the footer before any existing content.


As also advised in the link, you should consider renaming the macro as 'MailMergeToDoc'. That way, it will run automatically when the user clicks on the 'Edit Individual Documents' button.

[Bratone]

I am running the code before clicking "Edit Individual Documents". If I run it after, the code generates an error on the line .Destination = wSendToNewDocument and it says "Run-time error 5882, Requested object is not available".


If your mailmerge main document has a header and/or footer, it is simply not possible for the macro to not include those. I have confirmed that in testing.

Did you test using my code ? If yes, I really don't understand why for me it's not working.

[macropod]

Your code is in all material respects the same as that in the link I gave you. I cannot see how it's possible to get the Run-time error 5882 with '.Destination = wdSendToNewDocument', whichever way you run the code. It runs exactly the same code lines in the same way in either case.


I cannot test your code directly, since I don't have a mailmerge data source with fields named 'Batch_Number' & 'PO'. With adjustments to refer to datafields I do have in an Excel workbook, the code runs just fine - and preserves any existing headers & footers.