I have a handy macro that I use quite often that may help you. Warning! Be
careful. Copy the documents to another folder before running the macro in
case your macro doesn't run the way you want it to.
I'm posting the macro text here with some brief instructions, but I have a
Word document you can download with more detailed instructions and
screenshots. You can actually run the macro from this document!
Access here:
http://wordangel.com/RunMacroonallfiles.doc
The macro below is if you want to change the Style named Normal to Tahoma
10point. It will not change any text based on other styles. You'll need to
tweak this according to your document formats.
Paste the following macro (betwn the lines) into a module window in Visual
Basic (Alt+F11), scroll to the bottom of the macro and paste your macro
between: Sub DoWork(wdDoc As Document) and End Sub (paste yours over my font
changing macro). Finally, replace "C:\(my folder name)" with the path to the
folder you want the macro run on. Be sure it is enclosed in quotes when
you’re done or it won’t work!
_______________________________________________________________
'Run macro on all files (with directions)
Option Explicit
Dim scrFso As Object 'a FileSystemObject
Dim scrFolder As Object 'the folder object
Dim scrSubFolders As Object 'the subfolders collection
Dim scrFile As Object 'the file objectr
Dim scrFiles As Object 'the files objectr
Sub OpenAllFilesInFolder()
'starting place for trav macro
'strStartPath is a path to start the traversal on
Dim strStartPath As String
strStartPath = "C:\Documents and Settings\abivins\Desktop\Test Macro
folder"
'stop the screen flickering
Application.ScreenUpdating = False
'open the files in the start folder
OpenAllFiles strStartPath
'search the subfolders for more files
SearchSubFolders strStartPath
'turn updating back on
Application.ScreenUpdating = True
End Sub
Sub SearchSubFolders(strStartPath As String)
'starts at path strStartPath and traverses its subfolders and files
'if there are files below it calls OpenAllFiles, which opens them one
by one
'once its checked for files, it calls itself to check for subfolders.
If scrFso Is Nothing Then Set scrFso =
CreateObject("scripting.filesystemobject")
Set scrFolder = scrFso.getfolder(strStartPath)
Set scrSubFolders = scrFolder.subfolders
For Each scrFolder In scrSubFolders
Set scrFiles = scrFolder.Files
If scrFiles.Count > 0 Then OpenAllFiles scrFolder.Path 'if there are
files below,call openFiles to open them
SearchSubFolders scrFolder.Path 'call ourselves to see if there are
subfolders below
Next
End Sub
Sub OpenAllFiles(strPath As String)
' runs through a folder oPath, opening each file in that folder,
' calling a macro called samp, and then closing each file in that folder
Dim strName As String
Dim wdDoc As Document
If scrFso Is Nothing Then Set scrFso =
CreateObject("scripting.filesystemobject")
Set scrFolder = scrFso.getfolder(strPath)
For Each scrFile In scrFolder.Files
strName = scrFile.Name 'the name of this file
Application.StatusBar = strPath & "\" & strName 'the status bar is
just to let us know where we are
'we'll open the file fName if it is a word document or template
If Right(strName, 4) = ".doc" Or Right(strName, 4) = ".dot" Then
Set wdDoc = Documents.Open(FileName:=strPath & "\" & strName, _
ReadOnly:=False, Format:=wdOpenFormatAuto)
'Call the macro that performs work on the file pasing a
reference to it
DoWork wdDoc
'we close saving changes
wdDoc.Close wdSaveChanges
End If
Next
'return control of status bar to Word
Application.StatusBar = False
End Sub
'this is where a macro would be that would actually do something
Sub DoWork(wdDoc As Document)
With ActiveDocument.Styles("Normal").Font
.Name = "Tahoma"
.Size = 10
End With
End Sub
_______________________________________________________________
