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
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 have to loop through a lot of Templates that are data enabled and insert the Path & Filename as Text into the header, so that when I print them showing codes not values, it doesn't affect the Path/Filenames. So my task is to do this in this order:
Open Template (unless it can be done programatically!)
Insert Path & Filename as Text into header
Send to Print
Quit without saving Template
Do next Template
Here's what I have to loop through the folders...
Sub PrintAllFilesInAFolder()
Dim sMyDir As String
Dim sDocName As String
' The path to obtain the files.
sMyDir = "C:\SomeFolder\SomeSubFolder\SomeDocument\"
sDocName = Dir(sMyDir & "*.dotx")
While sDocName <> ""
' Print the file.
Application.PrintOut FileName:=sMyDir & sDocName
' Get next file name.
sDocName = Dir()
Wend
End Sub
Don't know how to do it, so I'd be extremely grateful if someone could slot the vba in where I need it :-)
They are Word 2007 Templates
Sub PrintAllFilesInAFolder()
Dim sMyDir As String
Dim sDocName As String
Dim doc As Document
' The path to obtain the files.
sMyDir = "H:\WORK RELATED\TESTING MACROS\"
sDocName = Dir(sMyDir & "*.doc")
While sDocName <> ""
' Open the file.
Set doc = Documents.Open(FileName:=sMyDir & sDocName)
Call PathFileNameInHeader ' Gets macro to insert field in header
Application.PrintOut FileName:=sMyDir & sDocName 'Prints document in current
folder
doc.Close wdDoNotSaveChanges
' Get next file name.
sDocName = Dir()
Wend
End Sub
Sub PathFileNameInHeader()
'
' Inserts Path & Filename field in header, then converts field to plain text
'
'
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"FILENAME \* Caps \p ", PreserveFormatting:=True
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Fields.Unlink
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
I've tested this numerous times and it works for me.
I have come across a macro from a user on this site but noticed it doesn't rename the file if already exists. Can someone please help;
docNameField = "PID"
' 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
End If
' Execute Mail Merge action
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With
' Save generated document and close it after saving
ActiveDocument.ExportAsFixedFormat _
OutputFileName:=savePath & strDocName & ".pdf", _
ExportFormat:=wdExportFormatPDF
ActiveDocument.Close False
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next rec
I have seen a few guidlines on how to do this using manual pointers to save file location but within this sameple "savepath" is already defined based on the directory the file is in.
I am thinking something like the following;
Do While .FileExists(strPath)
i = i + 1
OutputFileName:=savePath & strDocName & i, _
ExportFormat:=wdExportFormatPDF
ActiveDocument.Close False
Loop
I am unsure how to proceed / whether this is correct and would appreciate any advice.
I am providing a FileExists function:
Public Function FileExists(sFileName As String) As Boolean
Dim obj_fso As Object
Set obj_fso = CreateObject("Scripting.FileSystemObject")
FileExists = obj_fso.fileExists(sFileName)
Set obj_fso = Nothing
End Function
A simple function to check if a file exists. While Scripting.FileSystemObject works fine, it's extremely slow. Dir() is much quicker.
Public Function FileExists(ByVal Filename As String) As Boolean
FileExists = Len(Dir(Filename, vbDirectory)) > 0
End Function
If FileExists("Some path") then ...
I wish to mail merge and email from an Access query and pre setup word doc. It appears to work fine, as a the merged data document appears along with a new merged document that I have (for now) save. BUT what I really want it to do is send the actual email, rather than having to manually go to 'Finish & Merge" from MsWord. Simply it just doesn't actually send the email(s).
Function runMerge()
Dim StrFullDocPath As String
Dim oApp As Object
'Path to the word document
StrFullDocPath = "merge.docx" 'have removed the full path
'to save file name
outFileName = "Renewals_" & Format(Now(), "dd-mm-yyyy")
If Dir(StrFullDocPath) = "" Then
MsgBox "Document not found"
Else
'Create an instance of MS Word
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
'Open the Document
oApp.Documents.Open FileName:=StrFullDocPath
End If
With oApp
With .ActiveDocument.MailMerge
.MainDocumentType = wdEMail
.OpenDataSource _
Name:="myDB.accdb", _
LinkToSource:=True, _
AddToRecentFiles:=False, _
Connection:="QUERY qryCheckRenews", _
SQLStatement:="SELECT * FROM [qryCheckRenews]"
.Destination = wdSendToEmail
.MailAddressFieldName = "EmailAddress"
.MailFormat = wdMailFormatHTML
.MailAsAttachment = False
.MailSubject = "testing testing 1, 2, 3"
.SuppressBlankLines = True
.Execute Pause:=False
MsgBox "Mail Merge Complete ", vbOKOnly, "myDB"
End With
oApp.ActiveDocument.SaveAs2 FileName:="Renewal" & outFileName & ".docx"
'oApp.Documents.Close savechanges:=False
Set oApp = Nothing
End With
'Exit Sub
'ErrTrap:
' MsgBox Err.Description, vbCritical
End Function
Any help gratefully received
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.