microsoft.public.word.vba.general

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