Execute macro for all documents in the folder

[RPMitchal]

Word 2007

Hello Gurus:

It seems as though the below macro from an earlier posting was put together
for a version of Word that is older than 2007. In testing it, I found that
among other things, “application.filesearch†is no longer a valid application
within Word 2007.

Unfortunately, I am not yet well versed enough with VBA to be able to work
around it or come up with a correctly working substitute.

Is there any chance at all that one of you fine folks may be able to “tweakâ€
this code so that it will indeed work with 2007? I can think of several
current projects for which I could make use of this macro.

If so, I would be so greatly appreciative.

Thanks – Rod
______________________________________________

Subject: execute macro for all documents in the folder
10/31/2005 9:41 AM PST
By: (e-mail address removed)

I'm really leary about posting my code up, but i'm going to cause i think my
macro is better than what they have. I give anyone permission to alter the
code i provide. I'm also embarressed if there are errors in it, as i know
there are a few things that are beyond my programming expertise, as i'm am
self-taught and don't have any VB experience and am learning this on my own.

If you have any suggestions, please give them, i'm very willing and ready to
learn everything i can about how to be a better programmer with this language.

What the program does-

1. Asks you if you want to save the files in FilteredHTML before you run a
macro on them.

2. Asks how many folders you want to run a macro on.

3. Allows input of the paths of all the folders to run the macro on.

4. Asks how many macros you want to run on each folder you input.

5. Asks for the name(s) of the macro(s) you want to run.

6. Asks if you want to save them in FilteredHTML when the macro(s) are done.

And now the code-

Sub MacroRunner()

'this macro will allow for the
'running of a macro on a whole folder
'or, many folders. If you want you can
'save the initial file as FilteredHTML
'so when the macro is actually run
'it will run on a filtered HTML file

Application.ScreenUpdating = False
Dim counter, y, z As Integer
Dim fPath, fiType, path, fLog, mLog, f, d, tLog, flist, _
convert, MtoRun, MtoRunName, fFilename, mFilename, _
nmacros, nfolders As String
Dim doc As Document

Set f = CreateObject("Scripting.FileSystemObject")
fFilename = Environ$("APPDATA") & "\~folders" & ".txt"
mFilename = Environ$("APPDATA") & "\~macros" & ".txt"
Set tLog = f.Createtextfile(fFilename, True)
Set mLog = f.Createtextfile(mFilename, True)

convert = MsgBox(prompt:="Do you want convert everything to Filtered
HTML?", _
buttons:=vbYesNo)

Application.ScreenRefresh

fiType = MsgBox(prompt:="Do you want to save completed files in Filtered
HTML?", _
buttons:=vbYesNo)

Application.ScreenRefresh

nfolders = InputBox(prompt:="How many folders do you want to run macro
on?")

If Len(nfolders) = 0 Then
MsgBox ("You hit cancel or didn't put anything in.")
Exit Sub
End If

Application.ScreenRefresh

For y = 1 To nfolders

If nfolders = 1 Then
path = InputBox(prompt:="Input the folder's path.")
ElseIf y = nfolders Then
path = InputBox(prompt:="Input the last folder's path.")
ElseIf y = 1 Then
path = InputBox(prompt:="Input the 1st folder's path.")
ElseIf y = 2 Then
path = InputBox(prompt:="Input the 2nd folder's path.")
ElseIf y = 3 Then
path = InputBox(prompt:="Input the 3rd folder's path.")
Else
path = InputBox(prompt:="Input the " & y & "th folder's path.")
End If

If Len(path) = 0 Then
MsgBox ("You hit cancel or didn't put anything in.")
Exit Sub
End If

tLog.writeline (path)

Application.ScreenRefresh

Next y

nmacros = InputBox(prompt:="How many macros do you want to run?")

If Len(nfolders) = 0 Then
MsgBox ("You hit cancel or didn't put anything in.")
Exit Sub
End If

Application.ScreenRefresh

For y = 1 To nmacros

If nmacros = 1 Then
MtoRun = InputBox(prompt:="Input the macro's name you want to
run on all of the files.")
ElseIf y = nmacros Then
MtoRun = InputBox(prompt:="Input the last macro's name you want
to run on all of the files.")
ElseIf y = 1 Then
MtoRun = InputBox(prompt:="Input the 1st macro's name you want
to run on all of the files.")
ElseIf y = 2 Then
MtoRun = InputBox(prompt:="Input the 2nd macro's name you want
to run on all of the files.")
ElseIf y = 3 Then
MtoRun = InputBox(prompt:="Input the 3rd macro's name you want
to run on all of the files.")
Else
MtoRun = InputBox(prompt:="Input the " & y & "th macro's name
you want to run on all of the files.")
End If

If Len(MtoRun) = 0 Then
MsgBox ("You hit cancel or didn't put anything in.")
Exit Sub
End If

mLog.writeline (MtoRun)

Application.ScreenRefresh

Next y

tLog = (fFilename)
mLog = (mFilename)

Open tLog For Input As #1

Do While Not EOF(1)

Line Input #1, fPath

If convert = vbYes Then
With Application.FileSearch

.NewSearch
.LookIn = fPath
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles

If Not .Execute() = 0 Then
For counter = 1 To .FoundFiles.Count
Set doc = Documents.Open(.FoundFiles(counter))
ActiveDocument.SaveAs
FileFormat:=wdFormatFilteredHTML
ActiveDocument.Close
Set doc = Nothing
Next counter
Else
MsgBox "No Word Documents in specified folder(s)"
End If
End With
End If

With Application.FileSearch

.NewSearch
.LookIn = fPath
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles

If Not .Execute() = 0 Then
For counter = 1 To .FoundFiles.Count
Open mLog For Input As #2
Set doc = Documents.Open(.FoundFiles(counter))
Do While Not EOF(2)
Line Input #2, MtoRunName
Application.Run MtoRunName
Loop
If fiType = vbYes Then
ActiveDocument.SaveAs
FileFormat:=wdFormatFilteredHTML
Else
ActiveDocument.Save
End If
ActiveDocument.Close
Set doc = Nothing
Close #2
Next counter
Else
MsgBox "No files in specified folder(s)"
End If
End With
Loop

Close #1

f.deletefile mFilename
f.deletefile fFilename

Application.ScreenUpdating = True
MsgBox "Finally... Done"

End Sub

 

[Graham Mayor]

The following routines for processing a single folder or a tree of folders
should get you started. Neither macro does anything except open and close
each .docx document in the folder(s) as oDoc. You can do what you want with
oDoc when it is open where indicated.

It is simple enough to batch process a single folder.

Sub BatchProcess()
Dim strFileName As String
Dim strPath As String
Dim oDoc As Document
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 & "*.docx")
While Len(strFileName) <> 0
Set oDoc = Documents.Open(strPath & strFileName)
'*************************
'Do what you want with oDoc here
'*************************
oDoc.Close SaveChanges:=wdSaveChanges
strFileName = Dir$()
Wend
End Sub

If you want to batch process a selected folder and its sub folders also it
gets a tad more complicated:

Sub PickStartFolder()
Dim sPath As String
Dim Prompt As String
Dim Title As String
Dim Query As String
Dim TargetDoc As Document
Const FileType = "*.docx"
sPath = BrowseFolder("Select A Folder")
If sPath = "" Then
Prompt = "You didn't select a folder. The procedure has been
cancelled."
Title = "Procedure Cancelled"
MsgBox Prompt, vbCritical, Title
Else
If Len(sPath) = 3 Then
Prompt = "You have chosen to process the whole of the " _
& sPath & vbNewLine & "Drive. Are you sure you want to do this?"
Title = "Process whole drive?"
Query = MsgBox(Prompt, vbYesNo, Title)
If Query = vbNo Then
MsgBox "User Cancelled", vbInformation, "Cancelled"
Exit Sub
End If
End If
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TargetDoc = Documents.Add
ProcessFiles sPath, FileType
End If
End Sub
Sub ProcessFiles(strFolder As String, strFilePattern As String)
Dim strFileName As String
Dim strFolders() As String
Dim iFolderCount As Integer
Dim oDoc As Document
Dim i As Integer
'Collect child folders
strFileName = Dir$(strFolder & "\", vbDirectory)
Do Until strFileName = ""
On Error Resume Next
If (GetAttr(strFolder & "\" & strFileName) _
And vbDirectory) = vbDirectory Then
If Left$(strFileName, 1) <> "." Then
ReDim Preserve strFolders(iFolderCount)
strFolders(iFolderCount) = strFolder & "\" & strFileName
iFolderCount = iFolderCount + 1
End If
End If
strFileName = Dir$()
Loop
'process files in current folder
strFileName = Dir$(strFolder & "\" & strFilePattern)
Do Until strFileName = ""
Set oDoc = Documents.Open(strFolder & "\" & strFileName)
'*************************
'Do what you want with oDoc here
'*************************
oDoc.Close SaveChanges:=wdSaveChanges
strFileName = Dir$()
Loop
'Look through child folders
For i = 0 To iFolderCount - 1
ProcessFiles strFolders(i), strFilePattern
Next i
End Sub

'Credit for this code goes to Chip Pearson
'http://www.cpearson.com/Excel/BrowseFolder.aspx
Option Explicit
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const MAX_PATH As Long = 260
Type BrowseInfo
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal Pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long
Function BrowseFolder(Optional Caption As String = "") As String
Dim BrowseInfo As BrowseInfo
Dim FolderName As String
Dim ID As Long
Dim Res As Long
With BrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = Caption
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
FolderName = String$(MAX_PATH, vbNullChar)
ID = SHBrowseForFolderA(BrowseInfo)
If ID Then
Res = SHGetPathFromIDListA(ID, FolderName)
If Res Then
BrowseFolder = Left$(FolderName, InStr(FolderName, _
vbNullChar) - 1)
End If
End If
End Function

http://www.gmayor.com/installing_macro.htm


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

My web site www.gmayor.com

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

 

[RPMitchal]

Graham - thank you so very much - yet again!

The *ins* and *outs* of making sense out of VBA continues to escape me.
Someone told that one day it will all just *click*. I continue to read and
wait.

I appreciate all that you and your fellow Gurus do.

Rod

 

[Graham Mayor]

I don't believe it ever simply 'clicks', rather you get better at it the
more of it you do. I don't profess to be an excellent programmer. I am aware
of my limitations, but I do have the time to pass on what I know and
continue to learn from the comments of others. As I get older I find that
programming keeps the brain working. The puzzles that occasionally present
themselves in the Word forums are what keep bringing me back to the table.
Otherwise it's back to the Daily Telegraph cryptic crosswords

No matter how elegant or otherwise your code, the essential part is that it
should work. This is much the same as working in any language. Those who
have the best command of their native tongue produce their nations' poetry
and literary works. Others less gifted are still usually able to
communicate. I am not a gifted writer, nor a near illiterate - more the
journalist (at which I had several years experience )

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

My web site www.gmayor.com

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

 

[RPMitchal]

Hello Graham:

Oh No! I’ve honestly been reading, researching and attempting to learn VBA
for over four years now; having put more than a few “how to†books under my
belt. It doesn’t seem to matter how elementary the books may be, the
understanding of VBA continues to elude me.

I was sort of hanging onto and hoping that the *click* aspect of it was
simply being slow to slide home for me. Now to read that the *click* may not
ever be a guaranteed occurrence, puts me once again at a loss for finding an
effective process by which to learn and understand VBA. ïŠ

It makes perfect sense to me that *you get better at it the more of it you
do*. I’m just experiencing an inordinate amount of difficulty successfully
getting to the initial *do* stage. However, until such time as I can resolve
the obvious flaw in my learning process, it’s comforting to know that you and
the other Gurus of this forum remain available to lend a helping hand.

Should anyone care to share any successful attempts (however avant garde) at
learning VBA, I would be thrilled to hear about them.

Graham, wishing the very best of the Holiday Season to you and yours, I
continue to remain…

Very truly yours - Rod

 

[Graham Mayor]

You can start by using the macro recorder and examining the code to see what
it does, then follow the discussions in the vba forums to see the problems
others experience and the methods suggested to overcome them.. To that end
see http://www.gmayor.com/installing_macro.htm .

Bear in mind that computers are stupid and will only do what you tell them
to do. Then when you get stuck with a particular issue there are very many
on line references (including in the 2 links in my sig. block) that you can
examine to see how others have approached a problem. There is no right or
wrong way to approach a task. No matter what others will tell you the only
thing that matters is that your macro should work, and work reliably. That
is not to say that you cannot benefit from programming techniques that
produce more efficient easier to read code.

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

My web site www.gmayor.com

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

 

[RPMitchal]

Hello Graham:

Thanks so very much for your words of encouragement.

I'm going to keep at it - because the idea of not being able to understand
and effectively use VBA is non-negotiable.

Sincerely, Rod