How do I run a macro against multiple files

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.

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

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###"?

yes.  If you searched form PPP, it would be the first thing you found.  The filename can be PPP###.doc.  Thanks.

Hi Joanne, how are you?

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.

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

Select allOpen in new window

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

Oh - OK - my apologies.  I didn't realize that.  Give me a minute....

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

Select allOpen in new window

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

Select allOpen in new window

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

No problem.  I appreciate whatever help you can give me.

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

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

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

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.

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

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
         '*******************************************

Select allOpen in new window

Thanks for your help with this.  It will save me a lot of time.  Thanks again.