Automating the "save as PDF" function for a folder full of documen

[Legalbear]

In order to restore the lost toolbars/menus in Word 2007, I bought/installed
ToolbarToggle - works fine <insert rejoicing here>.

The only problem is, it causes Word to crater if I try the very easy method
of selecting a bunch of .DOC files and doing a "save as PDF" kind of action.
Uninstalling ToolbarToggle is **not** an option.

Ergo, what I ended up doing was opening this mess of files (test batch was
30) and doing a "save as PDF" and close operation on each one. To make this
uber-tedious task a bit easier, I've copied the relative items to the "Quick
Access" bar as a couple of button macros. This works, but for more than a
handful of documents, it's somewhat akin to having your skin peeled off...

So, being the macro-loving fool in the office, what I'd like to do is come
up with a macro that will do the following:
1. Open, 1 at a time, each Word document in a specified folder (I'm using
"PDF Input")
2. Do a "Save as PDF" using the original file name to a target folder ("PDF
Output")
3. Close the document
4. Loop until it's processed each file (btw: I want it to keep the original
files - I don't want a "convert-n-kill" kind of operation)
5. Once again allow my co-workers to be amazed at my wizardry <grins!!>

HELP??? I don't know enough about VBA to whomp this up from scratch so I'm
turning to you folks to help me keep from pulling my hair!

Mucho thanks - this area has been on the smartest things MS has come up
with!!!

 

[phorest]

Sub ConvertWordFilesToPDF()

' Take all Word files from one directory and save them as PDF files in
' another directory.

Dim strFilename As String
Dim strWordDirectory As String
Dim strPDFDirectory As String

' Put the Word and PDF directory names here:

strWordDirectory = "I:\WORD\"
strPDFDirectory = "I:\PDF\"

' Get the name of the first Word file.
strFilename = strWordDirectory & "*.doc"

' Hide all the opening/closing of files from the user to speed things up
Application.ScreenUpdating = True

' Do this stuff as long as there's another filename read
Do While strFilename <> ""
' Change to the directory of Word files
ChangeFileOpenDirectory strWordDirectory
' Open the Word file
Documents.Open , FileName:=strFilename, ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto

' Change to the directory of PDF files

ChangeFileOpenDirectory strPDFDirectory

' Save the Word file as an PDF file
ActiveDocument.SaveAs FileName:=Left(strFilename, Len(strFilename) -
4) & ".pdf", _
FileFormat:=wdFormatPDF, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="",
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData _
:=False, SaveAsAOCELetter:=False

' Close the file after saving in the new format
ActiveDocument.Close

' Read the next filename. If this returns "", the loop stops.
strFilename = Dir
Loop

' Let the user see what's going on again.
Application.ScreenUpdating = True


' Inform the user that we're done.
MsgBox ("All files converted to PDF files.")
End Sub


HTH

++++++++++++++++++++++++++++++++++++++++++++++++++