microsoft.public.word.vba.general

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
> >>>>>> 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" wrote:
> >>>>>>
> >>>>>>> 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