Hi!
I have the below code that splits a word into individual pdfs by each page, creating a folder and dropping the file in there. The thing is that I would like to be able to select every X amount of pages instead of being one pdf per page. Any suggestions?
Code:
Sub Merge_To_Individual_Files()
' Sourced from: https://www.msofficeforums.com/mail-...ps-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("X")) = "" Then Exit For
'StrFolder = .DataFields("Folder") & ""
StrName = .DataFields("X") & "_" & .DataFields("X")
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)
StrFolderRowName = StrFolder & StrName
If Dir(StrFolderRowName, vbDirectory) = "" Then MkDir StrFolderRowName
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:=StrFolderRowName & "" & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
NextRecord:
Next i
End With
End With
Application.ScreenUpdating = True
End Sub
Thanks,