microsoft.public.word.vba.general

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

"Graham Mayor" wrote:

> 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
>
> My web site www.gmayor.com
> Word MVP web site http://word.mvps.org
> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>
>
> Dan B wrote:
> > 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" wrote:
> >
> >> 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
> >>
> >> My web site www.gmayor.com
> >> Word MVP web site http://word.mvps.org
> >> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
> >>
> >>
> >>
> >> Dan B wrote:
> >>> 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.
> >>>
> >>> "Dan B" wrote:
> >>>
> >>>> Acrobat appears to get stuck when creating the second PDF (Q.doc).
> >>>>
> >>>> Maybe this needs tweaking. Any ideas?
> >>>>
> >>>> "Graham Mayor" wrote:
> >>>>
> >>>>> 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
> >>>>>
> >>>>> My web site www.gmayor.com
> >>>>> Word MVP web site http://word.mvps.org
> >>>>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
> >>>>>
> >>>>>
> >>>>> Dan B wrote:
> >>>>>> 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" wrote:
> >>>>>>
> >>>>>>> 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
> >>>>>>>
> >>>>>>> My web site www.gmayor.com
> >>>>>>> Word MVP web site http://word.mvps.org
> >>>>>>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
> >>>>>>>
> >>>>>>>
> >>>>>>> Dan B wrote:
> >>>>>>>> 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