Run one macro from another and edit filenames for PDF printing

[Dan B]

Hi.

I have a series of question / answer sheets as word docs. Each Word doc has
macros to show or hide answers. My intention is perform a batch process to
all docs as follows:

1) Open doc.
2) Print to PDF (answers showing by default) using word doc filename as PDF
filename.
3) Hide the answers using macro built into doc.
4) Print a second PDF using word doc filename (but replace the last
character 'a' with 'q') as PDF filename.

I have a macro that will convert a folder of docs to PDF (filenaming set in
PDF driver). My intention was to customise this to perfrom my complete batch
conversion. The code is as follows:

Sub BatchPrintPDF()
On Error GoTo err_FolderContents
Dim FirstLoop As Boolean
Dim DocList As String
Dim DocDir As String
Dim sPrinter As String
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
..Title = "Select Folder containing the documents to be printed to PDF and
click OK"
..AllowMultiSelect = False
..InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User"
Exit Sub
End If
DocDir = fDialog.SelectedItems.Item(1)
If Right(DocDir, 1) <> "\" Then DocDir = DocDir + "\"
End With

If Documents.Count > 0 Then
Documents.Close Savechanges:=wdPromptToSaveChanges
End If
Application.ScreenUpdating = False
FirstLoop = True
DocList = Dir$(DocDir & "*.doc")
Do While DocList <> ""
Documents.Open DocList
With Dialogs(wdDialogFilePrintSetup)
sPrinter = .Printer
..Printer = "Adobe PDF"
..DoNotSetAsSysDefault = True
..Execute
End With
ActiveDocument.PrintOut
ActivePrinter = sPrinter
ActiveDocument.Close Savechanges:=wdDoNotSaveChanges
DocList = Dir$()
FirstLoop = False
Loop
Application.ScreenUpdating = True
ActivePrinter = sPrinter
Exit Sub
err_FolderContents:
MsgBox Err.Description
Exit Sub
ActivePrinter = sPrinter
End Sub

I guess what I need to know is how to customize this code to do the filename
editing/saving tasks and also how to run the 'hide answers' macro in each
word doc opened.

Big thanks to everyone that's help me get this far. I'm nearly there!

Learning lots,

Dan.

 

[Jean-Guy Marcil]

Hi.

I have a series of question / answer sheets as word docs. Each Word doc has
macros to show or hide answers. My intention is perform a batch process to
all docs as follows:

1) Open doc.
2) Print to PDF (answers showing by default) using word doc filename as PDF
filename.
3) Hide the answers using macro built into doc.
4) Print a second PDF using word doc filename (but replace the last
character 'a' with 'q') as PDF filename.

Here is one way of going about it:

Declare a document object, like:
Dim docProcess As Document
Once your code has made sure that there are documents to process, create a
sub directory for the Student versions (parentDirectory\Student)
Use the doc object to open the first doc in the list:
Set docProcess= Documents.Open(DocList)
Use the doc to do the processing:
With docProcess
.Printout
.etc
End With
Since the easiest way to gt the PDF name is to ge it from the Word doc, I
would recommend doing a Save As with the suffix you want to the new Student
subdirectory.
Run the macro in that new doc by using something like:
ProjectName.ModuleName.SubName
Create the PDF.
Close the document.
Delete this doc document.
Repeat and rinse.

This way, when you are done, you will have a sub directory with the PDF
Question documents attached to the parent directory which will contain both
the PDF and the Word Answer sheet.

This solution will require more code than I have time to write right now.
You may try and ask specific questions with the parts you are having problems
with.

Or course, someone will drop in with a much simpler solution... I always
complicate things...

 

[Graham Mayor]

I looked at this late yesterday and decided that it lacked an essential bit
of information that I was going to come back to this morning.

3) Hide the answers using macro built into doc.

I think we need to know more about how the documents are hidden in order to
create a seamless process; other than that I was working along the same
lines to create a temporary folder to catch the documents in order to allow
Acrobat to create the PDFs using the file names, but it should be possible
to use the macro to generate the file names (if I knew a bit more about the
Acrobat object model)

I also wondered at the Word version as this is altogether much easier in
Word 2007 which can *save* documents in PDF format, thus making the naming
easier and avoiding the use of the print function altogether.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Dan B]

The code I'm using to 'hide' the answers is actually just adjusting the font
colour of all text in text boxes (from dark grey to white):

Sub HideAnswers()

' Find each text box and set it's font colour to white

Dim aShape As Shape

For Each aShape In ActiveDocument.Shapes
If aShape.Type = msoTextBox Then
With aShape
If .TextFrame.HasText Then
..TextFrame.TextRange.Font.Color = wdColorWhite
End If
End With
End If
Next

End Sub

To show the answers I use another macro to do the reverse (change font
colour in text boxes from white back to grey).

I'm using Word 2003 and ideally I will need the solution to work on Word XP.

Cheers,

Dan.

 

[Graham Mayor]

I was afraid you might be using Word 2003 Leave it with me for a bit.
I'll have a play around.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Dan B]

Thanks Graham - really appreciate it.

Would you say that Word 2007 makes life easier in terms of macro development
and general use? Maybe I should push the boss for an upgrade.

 

[Graham Mayor]

The following appears to work. As for the question about Word 2007, then
apart from the fact that for this particular issue the ability to *Save* as
PDF would have made things a tad simpler, I prefer to work in 2003. Word
2007 will make your life a whole lot more complicated than it needs to be.

The macro creates (where it doesn't already exist) a folder called Temp as a
sub folder of the folder that contains the documents. A loop then saves the
documents, running your code to reformat the text boxes, along the way with
the addition of Q to signify questions only and A to signify questions and
answers (which is what you originally requested). Another loop then runs on
the Temp folder to print to the Adobe driver, which will create its files
wherever you have told the driver to do so.

I have had to insert a couple of extra save as processes and a couple of
ChDir commands as the macro seemed to lose track of where it was working
without them. I am sure there must be a better way, but I can't immediately
see it. Unfortunately I don't know enough about addressing the Adobe driver
directly to offer that as a simpler alternative, but that should be
possible.

Sub BatchPrint2PDF()
Dim DocList As String
Dim DocDir As String
Dim sPrinter As String
Dim aShape As Shape
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
.Title = "Select Folder containing the documents to be printed to PDF
and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User"
Exit Sub
End If
DocDir = fDialog.SelectedItems.Item(1)
If Right(DocDir, 1) <> "\" Then DocDir = DocDir + "\"
End With
On Error Resume Next
MkDir DocDir & "Temp\"

If Documents.Count > 0 Then
Documents.Close Savechanges:=wdPromptToSaveChanges
End If
DocList = Dir$(DocDir & "*.doc")
Do While DocList <> ""
Documents.Open DocList
With ActiveDocument
sname = Left$(.name, (Len(.name) - 4)) & "A.doc"
.SaveAs DocDir & "Temp\" & sname
.SaveAs DocList
For Each aShape In .Shapes
If aShape.Type = msoTextBox Then
With aShape
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Color = wdColorWhite
End If
End With
End If
Next
sname = Left$(.name, (Len(.name) - 4)) & "Q.doc"
.SaveAs DocDir & "Temp\" & sname
.SaveAs DocList
.Close Savechanges:=wdDoNotSaveChanges
End With
DocList = Dir$()
Loop

DocList = Dir$(DocDir & "Temp\*.doc")
Do While DocList <> ""
ChDir DocDir & "Temp\"
Documents.Open DocList
ActivePrinter = sPrinter
With Dialogs(wdDialogFilePrintSetup)
sPrinter = .Printer
.Printer = "Adobe PDF"
.DoNotSetAsSysDefault = True
.Execute
End With
With ActiveDocument
.PrintOut
ActivePrinter = sPrinter
.Close Savechanges:=wdDoNotSaveChanges
End With
DocList = Dir$()
Loop
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Dan B]

Acrobat appears to get stuck when creating the second PDF (Q.doc).

Maybe this needs tweaking. Any ideas?

 

[Dan B]

I've managed to tweak the PDF driver setup and Acrobat doesn't always stick
now.

However, the macro seems to only convert the first word doc it finds in the
folder and then stops. Also, trying to convert with a previous Temp folder
in place seems to make Acrobat stick. Is there a way we can delete the
previous Temp folder before proceeding with conversion?

Any ideas?

If you get things working, is there any chance you can send me a screenshot
of how you have your PDF driver setup?

Cheers,

Dan.

 

[Graham Mayor]

Hmmmm. I've spotted another deliberate mistake. Saving back the original
document produces all the documents without the answers so it needs the
white changing back to black (or auto) again ie

The problem is undoubtedly with the section that names the files in the
temporary folder that is overly complicated. I'll have to play around with
that some more

Do While DocList <> ""
Documents.Open DocList
With ActiveDocument
sname = Left$(.name, (Len(.name) - 4)) & "A.doc"
.SaveAs DocDir & "Temp\" & sname
.SaveAs DocList
For Each aShape In .Shapes
If aShape.Type = msoTextBox Then
With aShape
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Color = wdColorWhite
End If
End With
End If
Next
sname = Left$(.name, (Len(.name) - 4)) & "Q.doc"
.SaveAs DocDir & "Temp\" & sname
For Each aShape In .Shapes
If aShape.Type = msoTextBox Then
With aShape
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Color = wdColorAuto
End If
End With
End If
Next
.SaveAs DocList
.Close Savechanges:=wdDoNotSaveChanges
End With
DocList = Dir$()
Loop



I am using Acrobat 8 and I have the printing preferences set up as shown at
http://www.gmayor.com/individual_merge_letters.htm

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Graham Mayor]

Hmmmm. I've spotted another deliberate mistake, and in sorting out that it
seems easier to process in three separate operations - creating the extra
files, formatting the blanked out text, and printing to PDF.

I am using Acrobat 8 and I have the printing preferences set up as shown at
http://www.gmayor.com/individual_merge_letters.htm

Now someone will come along and show us how it could have been done more
simply

Sub BatchPrint2PDF()
Dim DocList As String
Dim DocDir As String
Dim sPrinter As String
Dim aShape As Shape
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
.Title = "Select Folder containing the documents to be printed to PDF
and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User"
Exit Sub
End If
DocDir = fDialog.SelectedItems.Item(1)
If Right(DocDir, 1) <> "\" Then DocDir = DocDir + "\"
End With

On Error Resume Next
MkDir DocDir & "Temp\"

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If

'First loop creates the extra documents in the temporary folder
DocList = Dir$(DocDir & "*.doc")
Do While DocList <> ""
Documents.Open DocList
With ActiveDocument
sname = Left$(.name, (Len(.name) - 4)) & "A.doc"
.SaveAs DocDir & "Temp\" & sname
.SaveAs DocList
sname = Left$(.name, (Len(.name) - 4)) & "Q.doc"
.SaveAs DocDir & "Temp\" & sname
.SaveAs DocList
.Close SaveChanges:=wdDoNotSaveChanges
End With
DocList = Dir$()
Loop

'Second loop formats all the files ending in Q.doc to lose the answers
DocList = Dir$(DocDir & "Temp\*Q.doc")
Do While DocList <> ""
ChDir DocDir & "Temp\"
Documents.Open DocList
With ActiveDocument
For Each aShape In .Shapes
If aShape.Type = msoTextBox Then
With aShape
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Color =
wdColorWhite
End If
End With
End If
Next
.Close SaveChanges:=wdSaveChanges
End With
DocList = Dir$()
Loop

'Final loop outputs all the document files in the temp folder to PDF
DocList = Dir$(DocDir & "Temp\*.doc")
Do While DocList <> ""
ChDir DocDir & "Temp\"
Documents.Open DocList
ActivePrinter = sPrinter
With Dialogs(wdDialogFilePrintSetup)
sPrinter = .Printer
.Printer = "Adobe PDF"
.DoNotSetAsSysDefault = True
.Execute
End With
With ActiveDocument
.PrintOut
ActivePrinter = sPrinter
.Close SaveChanges:=wdDoNotSaveChanges
End With
DocList = Dir$()
Loop
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Graham Mayor]

Ignore this branch!

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Dan B]

Sorry Graham, but it still sticks on the second PDF conversion.

I have Acrobat 8 set up the same as you.

Are you getting a successful batch convsersion at your end?

Dan.

 

[Graham Mayor]

Yes - it is working here.
I have put three identical documents, each containing a text box with sample
text, in an otherwise empty folder.
The macro creates the six renamed files in the Temp folder, hides the
content of the text box and creates six PDF files, three with the text box
content, three without.
I don't know what else to suggest.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Dan B]

I've just discovered that it makes a difference where my target folder is
located.

If my target folder is on my desktop, the macro runs but sticks on the
second pdf file conversion. If the target folder is on a shared mapped
drive, the macro creates the new docs (Q and A) but doesn't even start the
PDF conversion.

My macros are stored in .dot templates in a shared workgroup folder.

I should also point out that the script only ever creates Q and A docs of
the first doc it finds (no matter how many docs are in the folder).

Dan :$

 

[Graham Mayor]

Our American friends are starting to come on line now, let's hope someone
can spot the error

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Dan B]

Does the macro create all of the Q and A docs before starting any PDF
conversion?

 

[Graham Mayor]

Yes!

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Dan B]

Hi Graham.

I'm still having no luck with this one. Do you have any further ideas?
Could you send me the working .doc that you have at your end?

Cheers,

Dan.

 

[Graham Mayor]

My test document simply has the following random text

Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy
nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut
wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit
lobortis nisl ut aliquip ex ea commodo consequat. Lorem ipsum dolor sit
amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt
ut laoreet dolore magna aliquam erat volutpat.

with a second copy of that random text repeated in a text box.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>