Ive got this code to create a bunk of individual pdf's from mail merging on word using an excel list. It's really solid for what i want it to do but it keeps adding a blank page at the end and i can't work out how to remove it?
Can anyone see an error ive made that would add this blank page in or how i could go about removing it?
Sub MailMergeToPdfBasic()
Dim masterDoc As Document, singleDoc As Document, lastRecordNum As Integer
Set masterDoc = ActiveDocument
masterDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord
lastRecordNum = masterDoc.MailMerge.DataSource.ActiveRecord
masterDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord
Do While lastRecordNum > 0
masterDoc.MailMerge.Destination = wdSendToNewDocument
masterDoc.MailMerge.DataSource.FirstRecord = masterDoc.MailMerge.DataSource.ActiveRecord
masterDoc.MailMerge.DataSource.LastRecord = masterDoc.MailMerge.DataSource.ActiveRecord
masterDoc.MailMerge.Execute False
Set singleDoc = ActiveDocument
singleDoc.SaveAs2 _
FileName:=masterDoc.MailMerge.DataSource.DataFields("DocFolderPath").Value & Application.PathSeparator & _
masterDoc.MailMerge.DataSource.DataFields("DocFileName").Value & ".docx", _
FileFormat:=wdFormatXMLDocument
singleDoc.ExportAsFixedFormat _
OutputFileName:=masterDoc.MailMerge.DataSource.DataFields("PdfFolderPath").Value & Application.PathSeparator & _
masterDoc.MailMerge.DataSource.DataFields("PdfFileName").Value & ".pdf", _
ExportFormat:=wdExportFormatPDF
singleDoc.Close False
If masterDoc.MailMerge.DataSource.ActiveRecord >= lastRecordNum Then
lastRecordNum = 0
Else
masterDoc.MailMerge.DataSource.ActiveRecord = wdNextRecord
End If
Loop
End Sub
all help appreciated
Related
So I have been trying to use a the below macro to split a mail-merged document into individual documents. When I run the macro, I receive "Runtime Error '5852' Requested object is not available." The issue is highlighted as .Destination = wdSendToNewDocumentwhen using the debug action.
I though that perhaps the issue was with the file being located on my OneDrive but after moving the files to a local drive, I recieved the same issue. Any insight into how to resolve this error would be helpful.
If more info is necessary, please let me know and I would be happy to answer as best I could.
Code for reference:
Sub MailMergeToDoc()
'
' MailMergeToDoc Macro
' Collects the results of the mail merge in a document
'
' 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 = .Path & "\"
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("Last_Name")) = "" Then Exit For
'StrFolder = .DataFields("Folder") & "\"
StrName = .DataFields("Last_Name") & "_" & .DataFields("First_Name")
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 & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
.SaveAs2 FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
NextRecord:
Next i
End With
End With
Application.ScreenUpdating = True
End Sub
This is pretty basic troubleshooting. You can't just copy code without understanding what it's doing.
Your MailMerge object does not exist when you're trying to run the mail merge.
You need to create a Mail Merge first in your Word doc - just use the Wizard - and that object will be magically filled. Then you'll have to progress to your next error.
I'm trying to use a macro I found online to save each doc from a mail merge into an individual PDF. But the macro does nothing. (never used macros before or VB) I tried stepping through the code and I get .DataSource.RecordCount = -1.
I can see the previewed documents, so the datasource is there. I figure there is something wrong with how it's getting the count value.
Any help is appreciated.
This is the whole macro:
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 = .Path & "\"
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("Last_Name")) = "" Then Exit For
'StrFolder = .DataFields("Folder") & "\"
StrName = .DataFields("key")
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 & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
.SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
NextRecord:
Next i
End With
End With
Application.ScreenUpdating = True
End Sub
I am having an issue trying to adjust a macro to export as pdf rather than a .dox
' Find the last record of the Mail Merge data
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
lastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
' Ask for user confirmation to start creating the documents
If MsgBox(lastRecord & " documents will be created based on your Mail Merge template.", vbOKCancel) = vbOK Then
' Ask for the name of the Merge Field name to use for the document names
docNameField = InputBox("Which Mergefield [name] should be used for document name?")
' Create document for each Mail Merge record (loop)
For rec = ActiveDocument.MailMerge.DataSource.FirstRecord To lastRecord
ActiveDocument.MailMerge.DataSource.ActiveRecord = rec
' Set document name for current record
If Trim(docNameField) = "" Then
strDocName = "document" & rec & ".docx"
Else
strDocName = ActiveDocument.MailMerge.DataSource.DataFields(docNameField).Value & ".docx"
End If
' Execute Mail Merge action
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With
' Save generated document and close it after saving
ActiveDocument.SaveAs FileName:=savePath & strDocName
ActiveDocument.Close False
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next rec
' Re-enable screen visuals
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Else 'if no destination folder was selected
'Re-enable screen visuals
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End If
End If
End Sub
I have tried to utilise activedocument.exportasfixedformat but cannot get this to work. Id appreciate any guidance.
Regards
As you said you should use ExportAsFixedFormat, something like this.
ActiveDocument.ExportAsFixedFormat _
OutputFileName:=savePath & strDocName & ".pdf", _
ExportFormat:=wdExportFormatPDF
I have 2 separate word documents with Mail Merge lists. And I have an excel workbook with 2 sheets. Based on the worksheet name & if the sheet is not empty, I need to send the mailmerge to that respective word document(s).
When I try to execute this code, it runs upto the first document and at the second document, it stops with an error Run-time Error 91 : Object variable or With block variable not set
I'm not sure what's causing this error (if it's the Dim variable or With block). Would greatly appreciate if someone could kindly help me rectify this error.
Sub Generate_Certificate()
Dim wd As Object
Dim wdoc_reg As Object
Dim wdoc_occ As Object
Dim strWbName_reg As String
Dim strWbName_occ As String
Const wdFormLetters = 0, wdOpenFormatAuto = 0
Const wdFormLetters1 = 0, wdOpenFormatAuto1 = 0
Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = -16
Const wdSendToNewDocument1 = 0, wdDefaultFirstRecord1 = 1, wdDefaultLastRecord1 = -16
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error Goto 0
For Each Sheet In ActiveWorkbook.Sheets
'Generate report using "Mailmerge" if any data available for Mailmerge1
If Sheet.Name Like "Sheet1" And IsEmpty(ThisWorkbook.Sheets("Sheet1").Range("A2").Value) = False Then
Set wdoc_reg = wd.Documents.Open("C:\Mailmerge1.docx")
strWbName_reg = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdoc_reg.MailMerge.MainDocumentType = wdFormLetters
wdoc_reg.MailMerge.OpenDataSource _
Name:=strWbName_reg, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWbName_reg & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Sheet1$`"
With wdoc_reg.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
wd.Visible = True
wdoc_reg.Close SaveChanges:=False
Set wdoc_reg = Nothing
Set wd = Nothing
End If
'Generate report using "Mailmerge" if any data available for Mailmerge2
If Sheet.Name Like "Sheet2" And IsEmpty(ThisWorkbook.Sheets("Sheet2").Range("A2").Value) = False Then
Set wdoc_occ = wd.Documents.Open("C:\Mailmerge2.docx")
strWbName_occ = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdoc_occ.MailMerge.MainDocumentType = wdFormLetters1
wdoc_occ.MailMerge.OpenDataSource _
Name:=strWbName_Occ, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto1, _
Connection:="Data Source=" & strWbName_occ & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Sheet2$`"
With wdoc_occ.MailMerge
.Destination = wdSendToNewDocument1
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord1
.LastRecord = wdDefaultLastRecord1
End With
.Execute Pause:=False
End With
wd.Visible = True
wdoc_occ.Close SaveChanges:=False
Set wdoc_Occ = Nothing
Set wd = Nothing
End If
Next
End Sub
As stated by Tim Williams in the question's comments.
You have Set wd = Nothing inside your loop, which will clear your reference to Word after the first sheet. Move that to just before the End Sub
I have got an interesting question and I couldn't find an answer somewhere.
I need to print around 2000 letters and of course I will do it with Mail Merge. Problem: I need every single one printed out in pdf-format. I found out that I have to use VBA macros in Word to get single letters (and not to get the whole bulk of letters in just one document) and this already works. But I couldn't find out how to automatically transfer them into pdf.
Does anyone has an idea and can help me? I appreciate your help.
What I got so far (to make single documents with mail merge):
Sub EinzelDatei()
Dim actpath As String, Dateiname As String
Dim fs As Object
Dim LetzterRec As Long
Const path As String = "D:\Test\"
On Error GoTo 0
Application.ScreenUpdating = False
Application.Visible = False
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
LetzterRec = Word.ActiveDocument.MailMerge.DataSource.ActiveRecord
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = wdFirstRecord
Do
If .DataSource.ActiveRecord > 0 Then
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
actpath = path & "\" 'Der aktuelle Pfad wird zusammengesetzt
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.folderexists(actpath) = False Then MkDir (actpath) 'Wenn der Pfad noch nicht existiert wird er jetzt erstellt
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
Dateiname = actpath & _
.DataFields("No").Value & "-" & _
.DataFields("Surname").Value & "," & _
.DataFields("First_Name").Value & ".docx" 'Dateiname = Name, Vorname.doc
End With
.Execute Pause:=False
ActiveDocument.SaveAs FileName:=Dateiname '
ActiveDocument.Close False
End If
If .DataSource.ActiveRecord < LetzterRec Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If
Loop
End With
MsgBox ("Erledigt")
Application.Visible = True
Application.ScreenUpdating = True
End Sub
Thank you in advance!!!
Use
ActiveDocument.SaveAs FileName:=Dateiname, FileFormat:=wdsaveformat.wdFormatPDF
or maybe
ActiveDocument.SaveAs2 FileName:=Dateiname, FileFormat:=wdsaveformat.wdFormatPDF
But it can only work in Word 2007 SP2 (I think) and later.
In Word 2007 it's the export functionality that can save a file as pdf:
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
"Path to PDF", ExportFormat:= _
wdExportFormatPDF
Bit simple, but you can just set your default printer to PDF creator then use the print function.In 2010 you get a print or edit option once you've done the merge.