We help IT Professionals succeed at work.

How do I run a macro against multiple files

447 Views
Last Modified: 2013-11-25
I have a number of reports that are mainframe generated.  Once I receive the reports, I have to run a macro to reformat each of the files which changes the margins, line spacing, etc.  Currently, I have to open each file, then run the reformat macro and then save the new word file.  I would like to be able to run a macro or other code from outside the files.  I would like to be able to select each of the files that I want to run the reformat macro on and then also have the new reformatted files saved with a new name.  Each file contains the wording "Report  No." which is followed by the actual report name.  I would like to use the actual report name as the new filename for the reformatted files.  Any help would be appreciated.
Comment
Watch Question

Joanne M. OrzechManager, Document Services Center
Top Expert 2004

Commented:
Well, I've found a macro here on EE that will loop through all files in a folder but I don't know how to grab the Report No. and rename the file .... I need more information.  How many characters are in the Report No.?  Is it consistent throughout all documents?  Meaning, does each Report No. contain - for example - five characters?

Please advise and I will attempt to assist you.

Author

Commented:
Hi J0rzech:
After the file is reformatted, the wording "Report  No." is found on the second line of every page in the report.  The report name always begins with "PPP" and then a 3 digit number follows, ex. PPP114, PPP181, etc.  So the actual report name is always 6 characters in all files.  Thanks.

Scott
Joanne M. OrzechManager, Document Services Center
Top Expert 2004

Commented:
So it is safe to assume if I were to search for "PPP", the Report No. PPP### would be the first instance I came upon?  Also, you want the file named "Report No PPP###"?

Author

Commented:
yes.  If you searched form PPP, it would be the first thing you found.  The filename can be PPP###.doc.  Thanks.
GrahamSkanRetired
CERTIFIED EXPERT
Top Expert 2012

Commented:
Hi Joanne, how are you?

Author

Commented:
Hi JOrzech:
I just spoke to the person responible for generating the reports and they can set it up on their end to that I will receive a file with the filename PPP###.  So that I will just have to save the reformatted file as a word document.  The files initially have a file extension like .02D or .071.  Maybe this makes this process easier.  Thanks.
Joanne M. OrzechManager, Document Services Center
Top Expert 2004

Commented:
Hi Graham!  I'm very well - thank you!  Hope you are too!

sharringtoncpa:
I took this code from another post on EE but it should do the trick for you.  You will need to put all documents to be revised in a folder, change the file path in the macro, and record a macro which formats the document(s) the way you want, and paste that code in Macro1.  Let me know if you need further assistance.    


Option Explicit
Option Compare Text
 
Sub OneType()
    Const MyPath = "C:\Adocs" ' Set the path.
    Const FileType = "*.doc"
    ProcessFiles MyPath, FileType
End Sub
 
Sub ProcessFiles(strFolder As String, strFilePattern As String)
    Dim strFileName As String
    Dim strFolders() As String
    Dim iFolderCount As Integer
    Dim i As Integer
    Dim MyFile As String
     
     'Collect child folders
    strFileName = Dir$(strFolder & "\", vbDirectory)
    Do Until strFileName = ""
        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 = ""
         'Do things with files here*****************
        ChDir strFolder
        Documents.Open FileName:=strFileName
        Macro1
        Documents(strFileName).Close wdSaveChanges
         '*******************************************
        strFileName = Dir$()
    Loop
     
     'Look through child folders
    For i = 0 To iFolderCount - 1
        ProcessFiles strFolders(i), strFilePattern
    Next i
End Sub
 
Sub Macro1()
    Selection.Find.ClearFormatting
'Here's where you would place the code which reformats the document the way you want it.
 
 
End Sub

Open in new window

Author

Commented:
Hi JOrzech:

I'm sorry its been while, I was temporarily reassigned.  I ran the macro above you suggested, but I subsituted my macro for Macro1.  It runs through each of the documents, but it doesn't save them once the documents have been "reformatted".  The documents should be saved as word documents.  Initially they are unidentified documents.  They all have a meaningless alpha numeric file extension.  Any suggestions would be appreciated.  Thanks.

Scott
Joanne M. OrzechManager, Document Services Center
Top Expert 2004

Commented:
Oh - OK - my apologies.  I didn't realize that.  Give me a minute....
Joanne M. OrzechManager, Document Services Center
Top Expert 2004

Commented:
Try this then...Remember to change the foldername to the location you're docs are...
Option Explicit
Option Compare Text
 
Sub OneType()
    Const MyPath = "C:\FOLDERNAME" ' Set the path.
    Const FileType = "*.*"
    ProcessFiles MyPath, FileType
End Sub
 
Sub ProcessFiles(strFolder As String, strFilePattern As String)
    Dim strFileName As String
    Dim strFolders() As String
    Dim iFolderCount As Integer
    Dim i As Integer
    Dim MyFile As String
     
     'Collect child folders
    strFileName = Dir$(strFolder & "\", vbDirectory)
    Do Until strFileName = ""
        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 = ""
         'Do things with files here*****************
        ChDir strFolder
        Documents.Open FileName:=strFileName
        Macro1
        Documents(strFileName).Close wdSaveChanges
         '*******************************************
        strFileName = Dir$()
    Loop
     
     'Look through child folders
    For i = 0 To iFolderCount - 1
        ProcessFiles strFolders(i), strFilePattern
    Next i
End Sub
 
Sub Macro1()
Dim strFileName As String
    Selection.Find.ClearFormatting
'Here's where you would place the code which reformats the document the way you want it.
 
    ActiveDocument.SaveAs (strFileName & ".doc")
    ActiveDocument.Close
End Sub

Open in new window

Author

Commented:
Hi JOrzech,

No problem.  I tried the new code you sent and it's giving me a debug error 4198.  When I debug it brings me to the follow code line:  
   ActiveDocument.SaveAs (strFileName & ".doc")
Per your instructions, I put this line of code and the subsequent line of code you provided after my macro called "Reformatter".  I wasnt' sure if I should put these lines of code inside or outside of my "With..End With Statement.  I tried it both ways and got the same error.  Any suggestions.  Thanks.

Scott
Option Explicit
Option Compare Text
 
Sub OneType()
    Const MyPath = "C:\adocs" ' Set the path.
    Const FileType = "*.*"
    ProcessFiles MyPath, FileType
End Sub
 
Sub ProcessFiles(strFolder As String, strFilePattern As String)
    Dim strFileName As String
    Dim strFolders() As String
    Dim iFolderCount As Integer
    Dim i As Integer
    Dim MyFile As String
     
     'Collect child folders
    strFileName = Dir$(strFolder & "\", vbDirectory)
    Do Until strFileName = ""
        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 = ""
         'Do things with files here*****************
        ChDir strFolder
        Documents.Open FileName:=strFileName
        Reformatter
        Documents(strFileName).Close wdSaveChanges
         '*******************************************
        strFileName = Dir$()
    Loop
     
     'Look through child folders
    For i = 0 To iFolderCount - 1
        ProcessFiles strFolders(i), strFilePattern
    Next i
End Sub
 
 
Sub Reformatter()
 
Dim strFileName As String
    Selection.Find.ClearFormatting
 
' Reformatter Macro
' Macro recorded 12/26/01 by Lou Azzara
'
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = InchesToPoints(0.92)
        .BottomMargin = InchesToPoints(0.92)
        .LeftMargin = InchesToPoints(1)
        .RightMargin = InchesToPoints(1)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(11)
        .PageHeight = InchesToPoints(8.5)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .GutterPos = wdGutterPosLeft
    End With
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = InchesToPoints(1.5)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(0.5)
        .RightMargin = InchesToPoints(0.5)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(11)
        .PageHeight = InchesToPoints(8.5)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .GutterPos = wdGutterPosLeft
    End With
    Selection.WholeStory
    Selection.Font.Size = 9
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdNormalView
    Else
        ActiveWindow.View.Type = wdNormalView
    End If
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceExactly
        .LineSpacing = 8
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
    
    End With
 
    ActiveDocument.SaveAs (strFileName & ".doc")
    ActiveDocument.Close
 
 
End Sub

Open in new window

Joanne M. OrzechManager, Document Services Center
Top Expert 2004

Commented:
Sorry - I was running out the door as I posted that.  Let me take another look.  My apologies.

Author

Commented:
No problem.  I appreciate whatever help you can give me.
GrahamSkanRetired
CERTIFIED EXPERT
Top Expert 2012

Commented:
Is the text of the error message: "Application-defined or object-defined error" or something more helpful?

Author

Commented:
Hi GrahamSkan,
Can you tell me how would I be able to determine that?  When I run the macro, it only tells me "Command Error 4198".  If I debug it brings me to that line of the code:  
ActiveDocument.SaveAs (strFileName & ".doc")

If I step through the macro, everything runs fine until that point.  Thanks.

Scott
Joanne M. OrzechManager, Document Services Center
Top Expert 2004

Commented:
I was working on this and think we could use the logic of the following code, but since Graham is here, he's better able to help you:

sDocName = Left(sOrigName, Len(sOrigName) - 4)
sDocName = sDocName & ".doc"
ActiveDocument.SaveAs FileName:=sDocName, _
  FileFormat:=wdFormatDocument
GrahamSkanRetired
CERTIFIED EXPERT
Top Expert 2012

Commented:
I would have expected a Run-Time error, but the Command Error bit of the message might help us.
I'll have a detailed look at the code.
Retired
CERTIFIED EXPERT
Top Expert 2012
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
Hi GrahamSkan:
I ran the new code you provided, but it doesn't save the documents.  The macro opens and reformats the files, but doesn't save them.  The files seem to be as they were prior to running the macro.  Also, I'm not sure that the Reformatter is finished, when the macro closes the file and goes to the next one.  I'm not certain about this, but from what I can see on the screen before the macro closes the file and moves to the next file, it doesn't seem finished. If you run Reformatter by itself you can see what the file should look like when Reformatter is done.   I have attached one of the files that I need to run the macro on.  Maybe you can see something that will help.  I had to add .txt in order for it to be accepted by EE.  Normally this file is received without the txt and the file extension is .26C1.  Thanks for your help.

Scott
PPP371.26C1.txt
GrahamSkanRetired
CERTIFIED EXPERT
Top Expert 2012

Commented:
I didn't realise that you were not dealing with Word documents. The code I gave you just resaved it as the original type, so all the formatting was dropped.

This code changes the extension and saves it as a Word document. The name  "PPP371.26C1" becomes "PPP371_26C1.doc". The close and save line is changed to a SaveAs and a separate close line is added.
         'Do things with files here*****************
        Set Doc = Documents.Open(strFolder & "\" & strFileName)
        Reformatter2 Doc
        Doc.SaveAs strFolder & "\" & Replace(strFileName, ".", "_") & ".doc", wdFormatDocument
        Doc.Close wdDoNotSaveChanges
         '*******************************************

Open in new window

Author

Commented:
Thanks for your help with this.  It will save me a lot of time.  Thanks again.
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.