microsoft.public.word.vba.general

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

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

My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Dan B wrote:
> 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