Hi all,

Using Macropods excellent macro (see source below) as a direct copy and paste, other than commenting out the split to word command. As I only want PDF files.

Getting the runtime error 4198 command failed message.

A couple of weeks ago this macro was working for me, so I know it does work on my system.

I have done a fair bit of googling to get to a solution to no luck. Any suggestions would be greatly appreciated.


Other:
- Working on local drive, desktop folder location
- Working from the locally saved MailMerged output file
- Mail merge in word using Excel from DDE option
- First paragraph of merged file for each record is Firstname Lastname, in Header Style
- section break for each record = 1
- Failing at line: .SaveAs FileName:=StrTxt & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False

Thank you!

Sub SplitMergedDocument()
' Sourced from: https://www.msofficeforums.com/mail-...ps-tricks.html
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, StrTxt As String
Dim Rng As Range, Doc As Document, HdFt As HeaderFooter
Const StrNoChr As String = """*./\:?|"


j = InputBox("How many Section breaks are there per record?", "Split By Sections", 1)
With ActiveDocument
' Process each Section
For i = 1 To .Sections.Count - 1 Step j
With .Sections(i)
'*****
' Get the 1st paragraph's text
StrTxt = Split(.Range.Paragraphs(1).Range.Text, vbCr)(0)
For k = 1 To Len(StrNoChr)
StrTxt = Replace(StrTxt, Mid(StrNoChr, k, 1), "_")
Next
' Construct the destination file path & name
StrTxt = ActiveDocument.Path & "" & StrTxt
'*****
' Get the whole Section
Set Rng = .Range
With Rng
If j > 1 Then .MoveEnd wdSection, j - 1
'Contract the range to exclude the Section break
.MoveEnd wdCharacter, -1
' Copy the range
.Copy
End With
End With
' Create the output document
Set Doc = Documents.Add(Template:=ActiveDocument.AttachedTem plate.FullName, Visible:=False)
With Doc
' Paste contents into the output document, preserving the formatting
.Range.PasteAndFormat (wdFormatOriginalFormatting)
' Delete trailing paragraph breaks & page breaks at the end
While .Characters.Last.Previous = vbCr Or .Characters.Last.Previous = Chr(12)
.Characters.Last.Previous = vbNullString
Wend
' Replicate the headers & footers
For Each HdFt In Rng.Sections(j).Headers
.Sections(j).Headers(HdFt.Index).Range.FormattedTe xt = HdFt.Range.FormattedText
Next
For Each HdFt In Rng.Sections(j).Footers
.Sections(j).Footers(HdFt.Index).Range.FormattedTe xt = HdFt.Range.FormattedText
Next
' Save & close the output document
'.SaveAs FileName:=StrTxt & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
.SaveAs FileName:=StrTxt & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
Next
End With
Set Rng = Nothing: Set Doc = Nothing
Application.ScreenUpdating = True
End Sub

Attached Images

runtimeerror4198.JPG (107.5 KB, 18 views)

The message suggests a file path error.
ChangetoHowever you should ensure that the document you are splitting has actually been saved or it won't have a path.
See also https://www.gmayor.com/MergeAndSplit.htm or
E-Mail Merge Add-in

__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com

Much thanks for your reply .

Edited to below, as per your suggestion, with same error unfortunately.

Definitely working from a Saved Mail Merged output file.

Sub SplitMergedDocument()
' Sourced from: https://www.msofficeforums.com/mail-...ps-tricks.html
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, StrTxt As String
Dim Rng As Range, Doc As Document, HdFt As HeaderFooter
Const StrNoChr As String = """*./\:?|"
j = InputBox("How many Section breaks are there per record?", "Split By Sections", 1)
With ActiveDocument
' Process each Section
For i = 1 To .Sections.Count - 1 Step j
With .Sections(i)
'*****
' Get the 1st paragraph's text
StrTxt = Split(.Range.Paragraphs(1).Range.Text, vbCr)(0)
For k = 1 To Len(StrNoChr)
StrTxt = Replace(StrTxt, Mid(StrNoChr, k, 1), "_")
Next
' Construct the destination file path & name
StrTxt = ActiveDocument.Path & "" & StrTxt
'*****
' Get the whole Section
Set Rng = .Range
With Rng
If j > 1 Then .MoveEnd wdSection, j - 1
'Contract the range to exclude the Section break
.MoveEnd wdCharacter, -1
' Copy the range
.Copy
End With
End With
' Create the output document
Set Doc = Documents.Add(Template:=ActiveDocument.AttachedTem plate.FullName, Visible:=False)
With Doc
' Paste contents into the output document, preserving the formatting
.Range.PasteAndFormat (wdFormatOriginalFormatting)
' Delete trailing paragraph breaks & page breaks at the end
While .Characters.Last.Previous = vbCr Or .Characters.Last.Previous = Chr(12)
.Characters.Last.Previous = vbNullString
Wend
' Replicate the headers & footers
For Each HdFt In Rng.Sections(j).Headers
.Sections(j).Headers(HdFt.Index).Range.FormattedTe xt = HdFt.Range.FormattedText
Next
For Each HdFt In Rng.Sections(j).Footers
.Sections(j).Footers(HdFt.Index).Range.FormattedTe xt = HdFt.Range.FormattedText
Next
' Save & close the output document
'.SaveAs FileName:=StrTxt & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
.SaveAs FileName:=StrTxt & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
Next
End With
Set Rng = Nothing: Set Doc = Nothing
Application.ScreenUpdating = True
End Sub

You have not changed the issue that is causing the error i.e.

If the document has been saved, the activedocument path would be e.g. "C:\Path".
If you add strTxt to this, the resulting path is "C:\pathstrTxt", whereas it should be "C:\path\strTxt"
Ensure the document is saved before running the macro.

__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com