Save each file in a folder as a filtered HTML and also as a PDF

[Cal Who]

I need to open each file (.doc) in a folder and then save it as a filtered
HTML and also as a PDF.



I wonder if that can be automated somehow.



I have no idea how to program word so I'm afraid that I could spend much
time learning how to only to find out it can't be done.



If it is a reasonable thing to do I'd really appreciate a sample of
something similar so I can get orientated and know what to look up.



Thank in advance

 

[Graham Mayor]

You can do this with Word 2007, provided you have the PDF plug-in installed
with the following macro.

Earlier Word versions do not have the ability to save to PDF and require a
third party application to do so.

If your third party application is not Acrobat, you may have to acknowledge
a confirmation prompt for each document conversion.

You would have to replace the code segment

..SaveAs FileName:=strNewPath & _
vShortName(0) & _
".pdf", _
FileFormat:=wdFormatPDF

With an option to print to the PDF driver. For Acrobat you would need:

Dim sPrinter As String
With Dialogs(wdDialogFilePrintSetup)
sPrinter = .Printer
.Printer = "Adobe PDF"
.DoNotSetAsSysDefault = True
.Execute
oDoc.PrintOut
.Printer = sPrinter
.Execute
End With

and set the acrobat printer driver to direct the output to a particular
folder. You will find some information on the driver setting at
http://www.gmayor.com/individual_merge_letters.htm

The original documents are unaffected.

Sub BatchProcess()
Dim strFilename As String
Dim strPath As String
Dim strNewPath As String
Dim vShortName As Variant
Dim oDoc As Document

'Set the path to receive the documents
strNewPath = "d:\My Documents\Test\Merge\"

Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFilename = Dir$(strPath & "*.doc")

While Len(strFilename) <> 0
Set oDoc = Documents.Open(strPath & strFilename)
With oDoc
vShortName = Split(strFilename, ".")
.SaveAs FileName:=strNewPath & _
vShortName(0) & _
".htm", _
FileFormat:=wdFormatFilteredHTML
.SaveAs FileName:=strNewPath & _
vShortName(0) & _
".pdf", _
FileFormat:=wdFormatPDF
.Close SaveChanges:=wdDoNotSaveChanges
End With
strFilename = Dir$()
Wend
End Sub


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


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Cal Who]

Wow You just generated that one-two-three-done!

You probably saved me a weeks work. Or more.

I never used macros and hardly used Word so I had to use Help to even find
out how to turn the Developer menus on.

But your code worked like clock work.

Would it be practical to add the following capability:

Create a document that had one line as follows for each filename read:

DropDownListTest.Items.Add("filename without extension")



Even if it was just on the screen so I could cut and paste it into some file
manually.

I can't say thanks strong enough - What a job that would have been for me.

I'm going to look for a book on Word macros and play with them as time
permits.

 

[Graham Mayor]

That is simple enough to add - see the marked lines. The following is based
on the original macro (without the PDF issue changes). I have also turned
off screen updating while the macro is running.

Sub BatchProcess()
Dim strFilename As String
Dim strPath As String
Dim strNewPath As String
Dim vShortName As Variant
Dim oDoc As Document

'****************************
'add the next line
Dim oLog As Document
'****************************
'Set the path to receive the documents
strNewPath = "d:\My Documents\Test\Merge\"

'****************************
'add the next line
Application.ScreenUpdating = False
'****************************
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
'****************************
'add the next line
Set oLog = Documents.Add
'****************************
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFilename = Dir$(strPath & "*.doc")

While Len(strFilename) <> 0
Set oDoc = Documents.Open(strPath & strFilename)
With oDoc
vShortName = Split(strFilename, ".")

'****************************
'add the next line
oLog.Range.InsertAfter _
"DropDownListTest.Items.Add(""" & _
vShortName(0) & """)" & vbCr

'****************************
.SaveAs FileName:=strNewPath & _
vShortName(0) & _
".htm", _
FileFormat:=wdFormatFilteredHTML
.SaveAs FileName:=strNewPath & _
vShortName(0) & _
".pdf", _
FileFormat:=wdFormatPDF
.Close SaveChanges:=wdDoNotSaveChanges
End With
strFilename = Dir$()
Wend
With oLog.Range
.ParagraphFormat.SpaceBefore = 0
.ParagraphFormat.SpaceAfter = 0
.Characters.Last.Delete
End With

'****************************
'add the next line
Application.ScreenUpdating = True

'****************************
End Sub


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


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Cal Who]

Thanks a lot.
Worked great!

That is simple enough to add - see the marked lines. The following is
based on the original macro (without the PDF issue changes). I have also
turned off screen updating while the macro is running.

Sub BatchProcess()
Dim strFilename As String
Dim strPath As String
Dim strNewPath As String
Dim vShortName As Variant
Dim oDoc As Document

'****************************
'add the next line
Dim oLog As Document
'****************************
'Set the path to receive the documents
strNewPath = "d:\My Documents\Test\Merge\"

'****************************
'add the next line
Application.ScreenUpdating = False
'****************************
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
'****************************
'add the next line
Set oLog = Documents.Add
'****************************
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFilename = Dir$(strPath & "*.doc")

While Len(strFilename) <> 0
Set oDoc = Documents.Open(strPath & strFilename)
With oDoc
vShortName = Split(strFilename, ".")

'****************************
'add the next line
oLog.Range.InsertAfter _
"DropDownListTest.Items.Add(""" & _
vShortName(0) & """)" & vbCr

'****************************
.SaveAs FileName:=strNewPath & _
vShortName(0) & _
".htm", _
FileFormat:=wdFormatFilteredHTML
.SaveAs FileName:=strNewPath & _
vShortName(0) & _
".pdf", _
FileFormat:=wdFormatPDF
.Close SaveChanges:=wdDoNotSaveChanges
End With
strFilename = Dir$()
Wend
With oLog.Range
.ParagraphFormat.SpaceBefore = 0
.ParagraphFormat.SpaceAfter = 0
.Characters.Last.Delete
End With

'****************************
'add the next line
Application.ScreenUpdating = True

'****************************
End Sub


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


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Graham Mayor]

You are welcome

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


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>