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