Export pages from Word file to PDF revised after x date

[RBTrenholme]

First time poster. I am trying to export to pdf every page of a Word 2010 file that has any revision in tracked changes after 2/16/17. I will then print those pdfs and use them to replace pages in an already printed document. What I've developed so far is below (except for the RevType Array arguments). The file name ideally will be sequentially numbered, such as revisedpage1.pdf, revisedpage2.pdf. If a page in the Word file has two revisions made after 2/16, all I need is 1 pdf of that page. Any help will be much appreciated!
Sub PDFofrevisions()
Dim srcDoc As Document, destDoc As Document
Dim oRev As Revision
Dim strCkDate As String
Dim CkDate As Date
Dim RevType As Variant
RevType = Array()
strCkDate = InputBox$("Enter date:")
If strCkDate = "" Then Exit Sub
If Not IsDate(strCkDate) Then Exit Sub
CkDate = CDate(strCkDate)
Set srcDoc = ActiveDocument

For Each oRev In srcDoc.Revisions
If CDate(Left$(Format(oRev.Date, "MM/dd/yyyy"), 10)) _
> CkDate Then

[gmayor]

I think the following should do what you want. If there is more than one revision on a page the page should only be saved once:

Option Explicit

Sub PDFofRevisions()
Dim srcDoc As Document
Dim oRev As Revision
Dim strCkDate As String
Dim strRevDate As String
Dim oRng As Range
Dim oPage As Range
RevType = Array()
strCkDate = InputBox$("Enter date:")
If strCkDate = "" Then Exit Sub
If Not IsDate(strCkDate) Then Exit Sub
strCkDate = Format(strCkDate, "yyyymmdd")

Set srcDoc = ActiveDocument
Set oRng = srcDoc.Range
For Each oRev In oRng.Revisions
strRevDate = Format(oRev.Date, "yyyymmdd")
If CLng(strRevDate) >= CLng(strCkDate) Then
oRev.Range.Select
Set oPage = oRev.Range.Bookmarks("\page").Range
SaveRangeAsPDF oPage, oPage.Information(wdActiveEndPageNumber)
oRng.Start = oPage.End
End If
Next oRev
lbl_Exit:
Exit Sub
End Sub

Private Sub SaveRangeAsPDF(oRng As Range, iPage As Integer)
Dim strFileName As String
Const strPath As String = "C:\Path\" 'The path where the PDF is to be saved
strFileName = strPath & "Revised Page " & iPage & ".pdf"
oRng.ExportAsFixedFormat OutputFilename:=strFileName, _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False
lbl_Exit:
Exit Sub
End Sub

[gmayor]

There is one major flaw in the above, and that is that saving ranges as PDF omits the header/footer information and that might be important in this instance. In that case you would need a programmable third party application to create the PDFs. Acrobat is the obvious, but expensive choice, so I would suggest instead PDFCreator. Personally I find the latest version unnecessarily bloated and all versions seem to want to install all sorts of unnecessary supplementary parts, so I would recommend using the earlier version 1.7.3 and only install the core program - http://www.npackd.org/p/org.pdfforge.PDFCreator/1.7.3


Option Explicit

Sub PDFofRevisions()
Dim srcDoc As Document
Dim oRev As Revision
Dim strCkDate As String
Dim strRevDate As String
Dim oRng As Range
Dim oPage As Range
Dim iPage As Integer
Dim strFilename As String
Const strPath As String = "C:\Path\" 'The path where the PDF is to be saved

strCkDate = InputBox$("Enter date:")
If strCkDate = "" Then Exit Sub
If Not IsDate(strCkDate) Then Exit Sub
strCkDate = Format(strCkDate, "yyyymmdd")

Set srcDoc = ActiveDocument
Set oRng = srcDoc.Range
For Each oRev In oRng.Revisions
strRevDate = Format(oRev.Date, "yyyymmdd")
If CLng(strRevDate) >= CLng(strCkDate) Then
oRev.Range.Select
Set oPage = oRev.Range.Bookmarks("\page").Range
iPage = oPage.Information(wdActiveEndPageNumber)
strFilename = "Revised Page " & iPage & ".pdf"
PrintPageToPDFCreator strFilename, strPath, srcDoc
oRng.Start = oPage.End
End If
Next oRev
lbl_Exit:
Exit Sub
End Sub

Private Sub PrintPageToPDFCreator(sPDFName As String, _
sPDFPath As String, _
oDoc As Document, _
Optional sMasterPass As String, _
Optional sUserPass As String, _
Optional bNoCopy As Boolean, _
Optional bNoPrint As Boolean, _
Optional bNoEdit As Boolean)
Dim pdfjob As Object
Dim sPrinter As String
Dim iCopy As Integer, iPrint As Integer, iEdit As Integer

If bNoCopy Then iCopy = 1 Else iCopy = 0
If bNoPrint Then iPrint = 1 Else iPrint = 0
If bNoEdit Then iEdit = 1 Else iEdit = 0

'Change active printer to PDFCreator
With Dialogs(wdDialogFilePrintSetup)
sPrinter = .Printer
.Printer = "PDFCreator"
.DoNotSetAsSysDefault = True
.Execute
End With

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
GoTo err_Handler
End If

.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF

If Not sMasterPass = vbNullString Then

'The following are required to set security of any kind
.cOption("PDFUseSecurity") = 1
.cOption("PDFOwnerPass") = 1
.cOption("PDFOwnerPasswordString") = sMasterPass

'To set individual security options
.cOption("PDFDisallowCopy") = iCopy
.cOption("PDFDisallowModifyContents") = iEdit
.cOption("PDFDisallowPrinting") = iPrint

'To force a user to enter a password before opening
.cOption("PDFUserPass") = 1
.cOption("PDFUserPasswordString") = sUserPass
'To change to High encryption
.cOption("PDFHighEncryption") = 1
End If

.cClearCache
End With

'Print the document page to PDF
oDoc.PrintOut Range:=wdPrintCurrentPage

'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
'Restore the original printer
With Dialogs(wdDialogFilePrintSetup)
.Printer = sPrinter
.Execute
End With
lbl_Exit:
Set pdfjob = Nothing
Exit Sub
err_Handler:
MsgBox "Unable to initialize PDFCreator." & vbCr & vbCr & _
"This may be an indication that the PDF application has become corrupted, " & _
"or its spooler blocked by AV software." & vbCr & vbCr & _
"Re-installing PDF Creator may restore normal working."
Resume lbl_Exit
End Sub

[RBTrenholme]

Graham, thanks very much. I think we're close. Two remaining issues:
I'd like to show tracked changes on the printed page. I changed the code to include Item:=wdPrintDocumentWithMarkup. That printed with markup but showing a large right hand margin where bubbles would show if I wanted them to show. I have Adobe and can print to it. I tried print to pdf work (see below), but that didn't work.

srcDoc.PrintOut OutputFileName:="strpath", Range:=wdPrintCurrentPage, Item:=
wdPrintDocumentWithMarkup , Copies:=1, Pages:="", PageType:= _
wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0


Both times I ran the code, I got a blank second page.
Any suggestions?

[macropod]

I am trying to export to pdf every page of a Word 2010 file that has any revision in tracked changes after 2/16/17. I will then print those pdfs and use them to replace pages in an already printed document.
IMHO that's a disaster waiting to happen! See: http://wordmvp.com/FAQs/Numbering/ChapterNumber.htm

[gmayor]

While I share Paul's trepidation, I should make a few observations. Printing a selection if individual pages to the Adobe driver is not without its problems. You need to setup the Adobe driver to print to a specific folder, because you cannot program the folder, only adapt to the folder configured. You will also have to set the driver to allow existing files to be overwritten.
In order to preserve the required filenames (as again the adobe printer driver does not accept filenames) you must rename the document before printing it. You can delete all the renamed documents at the end of the process.

The Adobe driver does not appear to be capable of printing the balloons, so you need to show the changes in line. When all this is accommodated the following will print the individual pages (or at least it does here) wiuthout affecting the original document - thgough I strongly urge you to work with copy of the document:

Option Explicit

Sub PDFofRevisions()
Dim oRev As Revision
Dim strCkDate As String
Dim strRevDate As String
Dim oRng As Range
Dim oPage As Range
Dim iPage As Integer
Dim strFilename As String
Dim strOriginalName As String
Dim iCount As Integer, iRev As Integer
'strPath below is the path the Adobe driver is configured to save in
Const strPath As String = "D:\My Documents\Test\Merge\TestMerge\"

strCkDate = InputBox$("Enter date:")
If strCkDate = "" Then Exit Sub
If Not IsDate(strCkDate) Then Exit Sub
strCkDate = Format(strCkDate, "yyyymmdd")

strOriginalName = ActiveDocument.FullName

Set oRng = ActiveDocument.Range
ActiveWindow.View.MarkupMode = wdInLineRevisions
For iRev = 1 To oRng.Revisions.Count
Set oRev = oRng.Revisions(iRev)
strRevDate = Format(oRev.Date, "yyyymmdd")
If CLng(strRevDate) >= CLng(strCkDate) Then
oRev.Range.Select
Set oPage = oRev.Range.Bookmarks("\page").Range
iPage = oPage.Information(wdActiveEndPageNumber)
strFilename = "Revised Page " & iPage & ".docx"
ActiveDocument.SaveAs2 strPath & strFilename
PrintPageToAdobePDF ActiveDocument, iPage
oRng.Start = oPage.End
End If
Next iRev
ActiveDocument.Close 0
Documents.Open strOriginalName
strFilename = Dir$(strPath & "Revised Page *.docx")
While strFilename <> ""
Kill strPath & strFilename
strFilename = Dir$()
Wend
lbl_Exit:
Exit Sub
End Sub

Private Sub PrintPageToAdobePDF(oDoc As Document, iPage As Integer)
Dim sPrinter As String
'Change the printer drive
With Dialogs(wdDialogFilePrintSetup)
sPrinter = .Printer
.Printer = "Adobe PDF"
.DoNotSetAsSysDefault = True
.Execute
End With
'Print the document page to PDF
oDoc.PrintOut Range:=wdPrintRangeOfPages, Copies:=1, Pages:=CStr(iPage)
'Restore the original printer
With Dialogs(wdDialogFilePrintSetup)
.Printer = sPrinter
.Execute
End With
lbl_Exit:
Exit Sub
End SubI haven't tested it but I suspect that while using Adobe code to SAVE as PDF you may be able to name the PDFs directly in code, but the issue with the changes and balloons will still remain.

[RBTrenholme]

Thank you both for your assistance. Graham's solution will work, but it's not practicable in my situation (it's a 757 page file). How about a simple macro that will go to each revision made after 2/16/17 and then stop? The user will do the printing to pdf.

[gmayor]

Remove '=' from the line


If CLng(strRevDate) >= CLng(strCkDate) Then thus
If CLng(strRevDate) > CLng(strCkDate) Then

The total number of pages shouldn't matter but if the process appears to hang add the line

DoEvents as shown below


End If
DoEvents
Next iRev
Make sure the target folder 'strPath' exists and is empty before running the process.