Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Microsoft Word Macro help

Status
Not open for further replies.
matt198992

matt198992

Technical User
Jun 28, 2011
10
US
can anyone help me with a microsoft word macro? i am trying to create a macro that runs a second macro across multiple files and subfolders. I got half of it down, to the point where i can execute the macro to all files in a single folder, however cannot get it to search subfolders. here is what i have:

Sub run_macro_on_multiple_files()
'
' run_macro_on_multiple_files Macro
'
'



Dim theFileName As String
theFileName = Dir("FOLDERPATH\*.doc")
Do While Len(theFileName) > 0
ChangeFileOpenDirectory "FOLDERPATH"
Documents.Open FileName:=theFileName
Application.Run MacroName:="FOLDERPATH"

ChangeFileOpenDirectory "C:\Documents and Settings\mmillar\Desktop\test"
ActiveDocument.SaveAs FileName:=theFileName, _
FileFormat:=wdFormatFilteredHTML
ActiveWindow.Close
theFileName = Dir
Loop
End Sub



any help?
 
Sort by date Sort by votes
I know there is a way to search subfolders, i just cant get it to work... can ANYONE help?
 
Upvote 0 Downvote
You can't use Dir recursively, and since 2007 you can't use Application.FileSearch, so you have to roll your own, something like this ..

Code: 
[blue]Sub Recursion()
    Recurrer "Put\Your\Top\Level\Path\Here\Ending\With\Backslash\"
End Sub

Sub Recurrer(Path As String)

    Dim DirN        As String
    Dim DirList()   As String
    Dim ndx         As Long
    
    [green]' Add vbSystem, vbHidden, etc., if you want such files[/green]
    DirN = Dir(Path, vbDirectory)
    
    Do While DirN <> ""
        If DirN = "." Or DirN = ".." Then
            [green]' Ignore[/green]
        Else
            If (GetAttr(Path & Application.PathSeparator & DirN) And vbDirectory) = vbDirectory Then
                If (Not DirList) = True Then
                    ReDim DirList(0 To 0)
                Else
                    ReDim Preserve DirList(0 To UBound(DirList) + 1)
                End If
                DirList(UBound(DirList)) = DirN
            End If
        End If
        DirN = Dir
        [green]' If it's a doc file do whatever you want here[/green]
    Loop
    
    [green]' Now process the saved subdirectories[/green]
    If (Not DirList) = True Then
    Else
        For ndx = 0 To UBound(DirList)
            Recurrer Path & DirList(ndx) & Application.PathSeparator
        Next
    End If
    
End Sub[/blue]

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website
 
Upvote 0 Downvote
It doesn't work, I'm sorry. That either runs the macro on only the specified file opened, or if I tell it to loop through folders using my previously posted macro, it still will only effect the root folder, and not the subdirectories. That or it gives me an error message about the "DirN = Dir" part of the macro...

Why is this so damned hard to do? You'd think if I can get it loop through one folder, it would not take much to loop through subfolders as well.

Any more help is greatly appreciated guys. =(
 
Upvote 0 Downvote
> That either runs the macro on only the specified file opened

What specified file opened?

> or it gives me an error message about the "DirN = Dir" part of the macro

What message?


Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website
 
Upvote 0 Downvote
Sub Recursion()
Recurrer "C:\Documents and Settings\mmillar\Desktop\test\"
End Sub

Sub Recurrer(Path As String)

Dim DirN As String
Dim DirList() As String
Dim ndx As Long
' Dim theFileName As String

' Add vbSystem, vbHidden, etc., if you want such files
DirN = Dir(Path, vbDirectory)

Do While DirN <> ""
If DirN = "." Or DirN = ".." Then
' Ignore
Else
If (GetAttr(Path & Application.PathSeparator & DirN) And vbDirectory) = vbDirectory Then
If (Not DirList) = True Then
ReDim DirList(0 To 0)
Else
ReDim Preserve DirList(0 To UBound(DirList) + 1)
End If
DirList(UBound(DirList)) = DirN
End If
End If
' DirN = Dir
DirN = Dir("C:\Documents and Settings\mmillar\Desktop\test\*.doc")
Do While Len(DirN) > 0
ChangeFileOpenDirectory "C:\Documents and Settings\mmillar\Desktop\test"
Documents.Open filename:=DirN
Application.Run MacroName:="Normal.NewMacros.deleteme"
ChangeFileOpenDirectory "C:\Documents and Settings\mmillar\Desktop\test"
ActiveDocument.SaveAs filename:=DirN, _
FileFormat:=wdFormatFilteredHTML
ActiveWindow.Close
DirN = Dir
Loop

Loop

' Now process the saved subdirectories
If (Not DirList) = True Then
Else
For ndx = 0 To UBound(DirList)
Recurrer Path & DirList(ndx) & Application.PathSeparator
Next
End If

End Sub





it is saying it cannot find the one of the files in the folder. I got it to work so that it would cycle through a SINGLE folder somehow, but i cannot seem to get that again.

 
Upvote 0 Downvote
Sub Recursion()
Recurrer "C:\Documents and Settings\mmillar\Desktop\test\"
End Sub

Sub Recurrer(Path As String)

Dim DirN As String
Dim DirList() As String
Dim ndx As Long
' Dim theFileName As String

' Add vbSystem, vbHidden, etc., if you want such files
DirN = Dir(Path, vbDirectory)

Do While DirN <> ""
If DirN = "." Or DirN = ".." Then
' Ignore
Else
If (GetAttr(Path & Application.PathSeparator & DirN) And vbDirectory) = vbDirectory Then
If (Not DirList) = True Then
ReDim DirList(0 To 0)
Else
ReDim Preserve DirList(0 To UBound(DirList) + 1)
End If
DirList(UBound(DirList)) = DirN
End If
End If
DirN = Dir

Application.Run MacroName:="Normal.NewMacros.run_macro_on_multiple_files"



Loop

' Now process the saved subdirectories
If (Not DirList) = True Then
Else
For ndx = 0 To UBound(DirList)
Recurrer Path & DirList(ndx) & Application.PathSeparator
Next
End If

End Sub




a better explanation:

Sorry, I gave the wrong one. My last post is the one I was messing with trying to get it to work. This is what is giving me problems. If i just tell it to run the "Format" macro, it does nothing. If i tell it to run the macro from my first post, the one that cycles through multiple files in a SINGLE folder, it returns "invalid call procedure or argument" and highlights the "DirN=Dir" section...

Sorry for all the hassle. =(
 
Upvote 0 Downvote
Sorry. I wasn't quite right in the way I pointed you. What the code does is run through a single directory checking files and folders. As it does so, it builds a list of (sub-)folders. Also as it does so it can process individual files any way it chooses but all I did was put a comment in about that, and I put it in the wrong place. When it has finished going through a directory, it then repeats the process for each of the directory names it has saved - one at a time, recursively.

Here's the code again with a small addition and a better comment - in the right place!

Code: 
[blue]Sub Recursion()
    Recurrer "C:\Users\Tony\Desktop\"
End Sub

Sub Recurrer(Path As String)

    Dim DirN        As String
    Dim DirList()   As String
    Dim ndx         As Long
    [COLOR=darkred]Dim pos         As Long [green]' added[/green][/color]
    
    [green]' Add vbSystem, vbHidden, etc., if you want such files[/green]
    DirN = Dir(Path, vbDirectory)
    
    Do While DirN <> ""
        If DirN = "." Or DirN = ".." Then
            [green]' Ignore[/green]
        Else
            If (GetAttr(Path & DirN) And vbDirectory) = vbDirectory Then
                If (Not DirList) = True Then
                    ReDim DirList(0 To 0)
                Else
                    ReDim Preserve DirList(0 To UBound(DirList) + 1)
                End If
                DirList(UBound(DirList)) = DirN
            [COLOR=darkred]Else
                [green]' DirN has a file name[/green]
                pos = InStrRev(DirN, ".")
                If pos > 0 Then
                    If InStr("doc docx docm", LCase(Right$(DirN, Len(DirN) - pos))) Then
                        [green]' The file is a doc, docx or docm
                        ' Do whatever with it[/green]
                    End If
                End If[/color]
            End If
        End If
        
        DirN = Dir [green]' This just gets the next name before going round again[/green]
        
    Loop
    
    ' Now process the saved subdirectories
    If (Not DirList) = True Then
    Else
        For ndx = 0 To UBound(DirList)
            Recurrer Path & DirList(ndx) & Application.PathSeparator
        Next
    End If
    
End Sub[/blue]

At the point where I've indicated 'DirN' has the name of a single Word document with 'Path'. To process it you need to pass the name to your routine, which can then do whatever you want.

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website
 
Upvote 0 Downvote
Sub Recursion()
Recurrer "C:\Documents and Settings\mmillar\Desktop\test\"
End Sub

Sub Recurrer(Path As String)

Dim DirN As String
Dim DirList() As String
Dim ndx As Long
Dim pos As Long ' added

' Add vbSystem, vbHidden, etc., if you want such files
DirN = Dir(Path, vbDirectory)

Do While DirN <> ""
If DirN = "." Or DirN = ".." Then
' Ignore
Else
If (GetAttr(Path & DirN) And vbDirectory) = vbDirectory Then
If (Not DirList) = True Then
ReDim DirList(0 To 0)
Else
ReDim Preserve DirList(0 To UBound(DirList) + 1)
End If
DirList(UBound(DirList)) = DirN
Else
' DirN has a file name
pos = InStrRev(DirN, ".")
If pos > 0 Then
If InStr("doc docx docm", LCase(Right$(DirN, Len(DirN) - pos))) Then
' The file is a doc, docx or docm
' Do whatever with it




Documents.Open filename:=DirN
Application.Run MacroName:="Normal.NewMacros.deleteme"

ActiveDocument.Save
ActiveWindow.Close
DirN = Dir



End If
End If
End If
End If

DirN = Dir ' This just gets the next name before going round again

Loop

' Now process the saved subdirectories
If (Not DirList) = True Then
Else
For ndx = 0 To UBound(DirList)
Recurrer Path & DirList(ndx) & Application.PathSeparator
Next
End If

End Sub





Sorry Tony, I know I am being a hassle here, but I am making a bit of progress.

The above code is as far as I can seem to get. It cycles through SOME of the files in the folder specified, but then has trouble finding a random file. For instance if "test1.doc", "test2.doc", and "test3.doc" were in the root folder, it would say "cannot find C:...\test1.doc" and the next time, after closing and re-opening word, it would say the same about test3.doc... and so on.

However it DOES open and close some of the files in that folder. The screen will show how an opening document, and the closing of it, then opening another, but after 2 or three, I get the path/file find problem. The macro also seems to not be run on any of the files being opened and supposedly saved and closed. I think it is not running the macro at all, because it seems the "date modified" is being updated; so it seems it IS saving.

I don't know... Whenever you have the time again, i would appreciate it. Thanks for your help regardless, and sorry for being a hassle. x(

 
Upvote 0 Downvote
DirN is just a file name - "test1.doc" or whatever. You need to use 'Path & DirN' if you want to open it from anywhere other than the default directory. Not sure what your 'deleteme' macro may do.

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website
 
Upvote 0 Downvote
'deleteme' is just a simple find and replace macro.

So this part of the code should be:



Documents.Open filename:=Path & DirN
Application.Run MacroName:="Normal.NewMacros.deleteme"

ActiveDocument.Save
ActiveWindow.Close
Path & DirN = Dir



???
 
Upvote 0 Downvote
Not sure that you want to be closing windows, and the line "DirN = Dir" should remain as is - don't add 'Path' like that (well, you can't, but don't try!)

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website
 
Upvote 0 Downvote
Sub Recursion()
Recurrer "C:\Documents and Settings\mmillar\Desktop\test\"
End Sub

Sub Recurrer(Path As String)

Dim DirN As String
Dim DirList() As String
Dim ndx As Long
Dim pos As Long ' added

' Add vbSystem, vbHidden, etc., if you want such files
DirN = Dir(Path, vbDirectory)

Do While DirN <> ""
If DirN = "." Or DirN = ".." Then
' Ignore
Else
If (GetAttr(Path & DirN) And vbDirectory) = vbDirectory Then
If (Not DirList) = True Then
ReDim DirList(0 To 0)
Else
ReDim Preserve DirList(0 To UBound(DirList) + 1)
End If
DirList(UBound(DirList)) = DirN
Else
' DirN has a file name
pos = InStrRev(DirN, ".")
If pos > 0 Then
If InStr("doc docx docm", LCase(Right$(DirN, Len(DirN) - pos))) Then
' The file is a doc, docx or docm
' Do whatever with it




Documents.Open filename:=Path & DirN
Application.Run MacroName:="Normal.NewMacros.deleteme"

ActiveDocument.Save
'ActiveWindow.Close
DirN = Dir



End If
End If
End If
End If

DirN = Dir ' This just gets the next name before going round again

Loop

' Now process the saved subdirectories
If (Not DirList) = True Then
Else
For ndx = 0 To UBound(DirList)
Recurrer Path & DirList(ndx) & Application.PathSeparator
Next
End If

End Sub



SOOOOOOOO CLOSSEEEE
Ok, I don't understand what is going on (again), but after cycling through some of the files, it comes up saying "invalid call procedure or argument" again at the DirN=Dir line. It has nothing stored in the DirN variable. The good news is that it went through all files in the first folder, then the subfolder, but not the sub-subfolder (?) (the third folder in the tree). Looking at the code, does it store ONLY the subfolders found in the root folder, or does it cycle through finding subfolders each loop?
 
Upvote 0 Downvote
The routine calls itself recursively and maintains a separate array at each level.

The problem is caused by having "DirN = Dir" twice in the loop - remove the one after the now commented out Close.


Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website
 
Upvote 0 Downvote
O.M.G. Finally!

After all this time, it works! Tony, if you were next to me, I would give you a friggen hug man. Thanks SOOOOOOOO much for sticking with me and not giving up on me. You have no idea how much this helps!!!!

I really cannot thank you enough!!
 
Upvote 0 Downvote
Here is the completed and finalized code to search folders and subfolders and run a macro on every doc, docx, or docm files that it finds.


Sub Recursion()
'enter your root file path here that you want to run this on. LEAVE THE BACKSLASH \ AT THE END
Recurrer "C:\Documents and Settings\mmillar\Desktop\test\"
End Sub

Sub Recurrer(Path As String)

Dim DirN As String
Dim DirList() As String
Dim ndx As Long
Dim pos As Long ' added

' Add vbSystem, vbHidden, etc., if you want such files
DirN = Dir(Path, vbDirectory)

Do While DirN <> ""
If DirN = "." Or DirN = ".." Then
' Ignore
Else
If (GetAttr(Path & DirN) And vbDirectory) = vbDirectory Then
If (Not DirList) = True Then
ReDim DirList(0 To 0)
Else
ReDim Preserve DirList(0 To UBound(DirList) + 1)
End If
DirList(UBound(DirList)) = DirN
Else
' DirN has a file name
pos = InStrRev(DirN, ".")
If pos > 0 Then
If InStr("doc docx docm", LCase(Right$(DirN, Len(DirN) - pos))) Then
' The file is a doc, docx or docm
' Do whatever with it




Documents.Open filename:=Path & DirN
'deleteme is the name of the macro you want to use; delete it and put in the name you want to run
Application.Run MacroName:="Normal.NewMacros.deleteme"

ActiveDocument.Save
ActiveWindow.Close




End If
End If
End If
End If

DirN = Dir ' This just gets the next name before going round again

Loop

' Now process the saved subdirectories
If (Not DirList) = True Then
Else
For ndx = 0 To UBound(DirList)
Recurrer Path & DirList(ndx) & Application.PathSeparator
Next
End If

End Sub




Everything works! Just posting this here for anyone who stumbles across this forum/thread. Thanks again!!
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Helpful tip
Microsoft Office 365 Word Macro Causing a Project is unviewable error
Replies
1
Views
930
dhookom
dhookom
Andrzejek
  • Question
Open Word as ReadOnly 1
Replies
4
Views
206
Andrzejek
Andrzejek
Andrzejek
  • Question
Hyperlinks in Word cut at #
Replies
2
Views
184
Andrzejek
Andrzejek
remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word 1
Replies
7
Views
860
strongm
strongm
remeng
  • Locked
  • Question
CTRL + BREAK from second macro button
Replies
5
Views
645
strongm
strongm

Part and Inventory Search

Sponsor

Back
Top