need help - looping through output files with similar filenames to extract data

[Fleetwood Mac Attack]

Hello and I apologize if this topic has been addressed already - I can't seem to find it anywhere.

Here's my situation: I have a bunch of output files from a traffic simulation that can all be opened in Excel as semicolon-delimited files. As each simulation runs 30 times, I have 30 different output files, titled something like "baseline_01.mes", "baseline_02.mes", and so forth.

I want to aggregate the results from each of these 30 files into one worksheet (the "summary" sheet). I aim to develop a macro that I can call from the summary sheet that opens up each of the 30 files in my output folder 1 by 1. Once each file is open, I want to call a subroutine that sorts the data within each output file before selecting some of this sorted data and pasting it into my "summary" sheet.

Essentially, if I have a folder with my 30 output files saved together, I need some code to open up each folder one at a time, perform some action on each file, and then close each file without saving. Seems easy enough, yes?

 

[cgcamal]

Hi,

There are several procedures/templates on the web to do what you want (loop through workbooks in folder) like this or this, the new thing would be the code you want to execute on each workbook.

With a sample of input and desired output would be better.

Regards

 

[Fleetwood Mac Attack]

Okay, that second link provided a little bit of insight, but I'm still pretty confused, especially with the syntax for referring to my file paths.

Here's what I've got: a folder in my hard drive, E:\Graduate Research\Work Zone TMPs\I-81 Pavement Reclamation\VISSIM Analysis\VCTIR Simulations_Baseline\Volumes. Within this "Volumes" folder are 30 output files, "basemap_01.mes" all the way to "basemap_30.mes".

I have a summary workbook outside of this folder, "VCTIR_Simulations_Baseline_Volumes.xlsx". I would like to write a macro that:
- opens up each of the 30 output files
- runs a separate macro that I have written on each file, which sorts the data within each output file, copies some of this data, and pastes this data into the summary workbook
- closes each output file without saving

I'm very new to VBA so I may need some "coaching" through this. Thanks in advance!

 

[cgcamal]

Hi FleetW_M_A,

What is the code you have so far?

You say you've written a macro to process each output file, I think you only have problems running that
macro for every output file. If so the other part(open each output file and execute a macro on each one)
would be something like:
(The code in red is an example macro, you must replace the macro you need instead of that text in red)

Sub Process_All_Files_in_Folder()
Dim wbOpen As Workbook
Dim wbNew As Workbook
Dim strPath As String, strExtension As String

[COLOR=Green]'This is your Path, change it if it's another one (Long path, splitted in 2 parts)
[/COLOR]strPath = "E:\Graduate Research\Work Zone TMPs\I-81 Pavement Reclamation\"
strPath = strPath & "VISSIM Analysis\VCTIR Simulations_Baseline\Volumes\"

'Comment out the 3 lines below to debug
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next

    ChDir strPath
[COLOR=Green]'This is the extension of output files-->Change extension to another if you want
[/COLOR]strExtension = Dir(strPath & "*.mes")
    
    Set wbNew = ActiveWorkbook
[COLOR=Green]'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 '##### Begin of code to execute in a Loop when each output file is imported ######[/COLOR]
[COLOR=Green]'*** This code will open each *.mes file and will add current *.mes sheet to summary book *** 
[/COLOR]        Do While strExtension <> ""
            Set wbOpen = Workbooks.Open(strPath & strExtension)
         
            With wbOpen
' [B][COLOR=Green]+++YOUR CODE MUST BE HERE +++[/COLOR][/B]
[COLOR=Red]                .Sheets(ActiveSheet.Name).Copy After:=wbNew.Sheets(wbNew.Sheets.Count)
                wbNew.Sheets(wbNew.Sheets.Count).Name = wbNew.Sheets(wbNew.Sheets.Count).Cells(1, 1)
                .Close SaveChanges:=False[/COLOR]
            End With
            
            strExtension = Dir
        Loop
[COLOR=Green]'Saving the summary book-->Change Name, File Format and path to real summary book path[/COLOR]
wbNew.SaveAs Filename:="[COLOR=Red]E:\Your\Other\Path\[/COLOR]", FileFormat:=xlWorkbookNormal

[COLOR=Green] '##### End of code to execute in a Loop when each output file is imported ######
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++[/COLOR]
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
End Sub

You only need to insert the code that sorts the data of each output file and pastes it into summary workbook.

If you still have problems with the macro that sorts each output file, it would be better if you upload a sample
of a output file and show what sort you need to copy from output files to summary workbook.

Hope this helps,

Regards.

 

[Fleetwood Mac Attack]

I think I found a solution. I found some code to get all of the file names from a folder and then store them as an array in a sheet. I then loop through each row of this array (each individual file name), open each one, and then run my own code. Thanks!

Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String
    
    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
    
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
NoFilesFound:
    GetFileList = False
End Function

Sub GetFileNames()
    Dim p As String, x As Variant

    p = "H:\Graduate Research\Work Zone TMPs\I-81 Pavement Reclamation\VISSIM Analysis\VCTIR Simulations_DetourModified2\Volumes\*.mes"
    x = GetFileList(p)
    
    Select Case IsArray(x)
        Case True 'files found
            Sheets("Files").Range("A:A").Clear
            For i = LBound(x) To UBound(x)
                Sheets("Files").Cells(i, 1).Value = x(i)
            Next i
        Case False 'no files found
            MsgBox "No matching files"
    End Select
End Sub

'Get file names of output files and store them as an array
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = "Files"
    'Before calling GetFileNames, make sure directory is same as MyFolder directory
    Call GetFileNames
    
    Const MyFolder As String = "H:\Graduate Research\Work Zone TMPs\I-81 Pavement Reclamation\VISSIM Analysis\VCTIR Simulations_DetourModified2\Volumes\"
    Dim MyFile As String

    FinalFileRow = Worksheets("Files").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To FinalFileRow
        MyFile = Worksheets("Files").Cells(i, 1).Value
        MyFileName = MyFolder & MyFile
        
        'Open individual MES files as semicolon-delimited files
        Workbooks.opentext FileName:= _
        MyFileName, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True

'++++++++++++++++++++++++++++++++++++++++++++++++++++++
'MY CODE GOES HERE TO PERFORM ON EACH FILE THAT GETS OPENED
'+++++++++++++++++++++++++++++++++++++++++++++++++++++

'Close .MES file
         ActiveWorkbook.Close (False)
         
    Next i

 

[cgcamal]

Well, noce for you that finally have the solution wanted!

Regards