Copy active Word Doc then perfrom Macro in "copied" doc

[pk247]

Hi Everyone,

I'll admit I've tried and tested how to do this myself but with unsuccessful results :banghead:. Would anyone be able to help me please with making sure my code is 100% safe? The activedocument is really, really important and I don't want my code doing anything I don't intend it to do...

1. With VBA save a copy of the existing Word document into the same filepath - I'm thinking that a hyphen tacked onto the end of the filename (less .docx) will suffice to "save" the file in the existing folder

2. Make sure the filename is recorded so that the code below can still use the filename (hyphen included) and filepath when it saves its PDF versions

3. Close and save the original (to keep it safe)

4. Run the code below which saves a PDF version of the Word Doc with and without highlights as well as printing and PDF''ing the "Signature Page"

5. Delete the copied version (I've no need for it)

Here's my code which works fine but I want to be confident that my original document is safe and sound:
As always, any help with this would be much appreciated!


Sub H_UH_PSP_SP_PDF()

Dim strSearch As String
Dim CurrentPAGE As Integer

Application.ScreenUpdating = False


'Save highlighted version in PDF Format
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
Replace(ActiveDocument.FullName, ".docx", "_Highlighted_Version.pdf"), _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

'Save UN-highlighted version in PDF Format
Selection.WholeStory
Options.DefaultHighlightColorIndex = wdNoHighlight
Selection.Range.HighlightColorIndex = wdNoHighlight
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
Replace(ActiveDocument.FullName, ".docx", "_No_Highlights.pdf"), _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

'Undo removal of highlighted text (2 is the last two steps)
ActiveDocument.Undo 2

'Go to top of doc, Approval Sig Page is always 3-4 pages from the top
Selection.HomeKey Unit:=wdStory

'Save the undo
ActiveDocument.Save

'Find Page with first instance of A.S. to Print & PDF
strSearch = "Approval Signatures"

With Selection.Find
.Forward = True
.Wrap = wdFindStop
.Text = strSearch
.Execute
End With

If Selection.Find.Found = True Then
'Print the page
CurrentPAGE = Selection.Information(wdActiveEndAdjustedPageNumber)
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="" & CurrentPAGE & "-" & CurrentPAGE & "", PageType:= _
wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
End If


'Now PDF the Sig Page
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
Replace(ActiveDocument.FullName, ".docx", "_Signature_Page.pdf"), ExportFormat:=wdExportFormatPDF, Range:=wdExportCurrentPage


Application.ScreenUpdating = True


End Sub



If you can point me in the right direction or have some code already that does the same thing then it would be great if you could share it with me please.

Thanks again evereyone!

Cheers,

Paul, Ireland :beerchug:

[gmayor]

The easiest way to achieve this is to create a new document using your active document as a template, then there are no unwanted accidental changes to that document. All the processing (apart from the printing and PDF of the signatures page) is done on the new document, which is discarded after use. Use variable names to identify the documents so there is no confusion over which document is 'active'. Process the documents by name.


Option Explicit

Sub H_UH_PSP_SP_PDF()

Dim strFilename As String
Dim strSearch As String
Dim CurrentPAGE As Integer
Dim oSource As Document
Dim oDoc As Document
Dim oRng As Range
Dim bFound As Boolean

Application.ScreenUpdating = False
ActiveDocument.Save
If Len(ActiveDocument.Path) = 0 Then Exit Sub
Set oSource = ActiveDocument
strFilename = oSource.FullName
Set oDoc = Documents.Add(Template:=strFilename)
Set oRng = oDoc.Range

'Save highlighted version in PDF Format
oDoc.ExportAsFixedFormat OutputFileName:= _
Replace(strFilename, ".docx", "_Highlighted_Version.pdf"), _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
From:=1, To:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False

'Save UN-highlighted version in PDF Format
'Options.DefaultHighlightColorIndex = wdNoHighlight
oRng.HighlightColorIndex = wdNoHighlight
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
Replace(strFilename, ".docx", "_No_Highlights.pdf"), _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
From:=1, To:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False

'Find Page with first instance of A.S. to Print & PDF
strSearch = "Approval Signatures"
With oRng.Find
Do While .Execute(FindText:=strSearch)
CurrentPAGE = oRng.Information(wdActiveEndAdjustedPageNumber)
bFound = True
Exit Do
Loop
End With

If bFound = True Then
'Print the page
oSource.PrintOut Range:=wdPrintRangeOfPages, _
Item:=wdPrintDocumentContent, _
Copies:=1, _
Pages:="" & CurrentPAGE & "-" & CurrentPAGE & "", _
PageType:=wdPrintAllPages, _
Collate:=True, _
Background:=True, _
PrintToFile:=False, _
PrintZoomColumn:=0, _
PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
'Now PDF the Sig Page
oSource.ExportAsFixedFormat OutputFileName:=Replace(strFilename, ".docx", "_Signature_Page.pdf"), _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportFromTo, From:=CurrentPAGE, To:=CurrentPAGE, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
End If
'oSource.Close wdDoNotSaveChanges 'Optional
oDoc.Close wdDoNotSaveChanges
Application.ScreenUpdating = True
lbl_Exit:
Set oDoc = Nothing
Set oSource = Nothing
Set oRng = Nothing
Exit Sub
End Sub

[pk247]

Absolutely perferct Graham! I never would have thought of using the template option. Thank you again very very much!! I popped a few quid via your Paypal because I am very grateful for all the help you've given me over the past year or so since I started learning VBA, it's not much but should be enough to buy yourself a pint :beerchug:


All the best,


Paul, Ireland