• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 305
  • Last Modified:

Macro that opens sequentially named workbooks and runs the same routine on each one

Basically, the folder  "H:\...\SourceFiles\" contains an expanding list of files with names like:

2011 Week 01.xls
2011 Week 02.xls, etc.

I want to open them one at a time and run the routine below on them. How do I do that? There might be other files in the folder that don't end with "Week ##.xls", so it would be important to have the file selection based on the common ending for each file.

Thanks,
John
Sub Aggregate()
Application.ScreenUpdating = False

Workbooks.Open Filename:= _
 "H:\Depts\css\A_ILS & Reliability\Reliability\1-CURRENT\System Reporting\SDAE\JAL\3_Working Files\SourceFiles\JAL SourceFile 2011 Week 01.xls"
 Dim top As Range, btm As Range, rng As Range
 Set top = [A6]
 Set btm = top.End(xlDown)
 Set rng = Range(top, btm).EntireRow

 rng.Copy
 ThisWorkbook.Activate
 Dim top2 As Range
 Set top2 = [A4].End(xlDown).Offset(1, 0)
 top2.PasteSpecial Paste:=xlPasteValues
 Application.CutCopyMode = False
 ActiveWindow.ActivateNext
 ActiveWorkbook.Close
 
Application.ScreenUpdating = True
End Sub

Open in new window

0
gabrielPennyback
Asked:
gabrielPennyback
  • 2
  • 2
1 Solution
 
SiddharthRoutCommented:
Try this.

Please note that this code is tried and tested. The only part that is not tried is your main code and I have indicated it in the code below.

If you get any errors, do let me know. :)

Dim top As Range, btm As Range, rng As Range, top2 As Range
Dim Fldr As String
Dim MYFileArray() As String
Dim j As Long

Sub Aggregate()
    Application.ScreenUpdating = False
    
    Fldr = "H:\Depts\css\A_ILS & Reliability\Reliability\1-CURRENT\System Reporting\SDAE\JAL\3_Working Files\SourceFiles"
    j = 0
    
    ListFiles Fldr, "*.xls"
    
    For i = 1 To UBound(MYFileArray) - 1
        myarray = Split(GetFilenameFromPath(MYFileArray(i)), ".")
        If myarray(0) Like "*Week ##" Then
            '~~> The below code till "ActiveWorkbook.Close" has not been tested
            Workbooks.Open Filename:=MYFileArray(i)
            Set top = [A6]
            Set btm = top.End(xlDown)
            Set rng = Range(top, btm).EntireRow
            rng.Copy
            ThisWorkbook.Activate
     
            Set top2 = [A4].End(xlDown).Offset(1, 0)
            top2.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            ActiveWindow.ActivateNext
            ActiveWorkbook.Close
        End If
    Next
     
    Application.ScreenUpdating = True
End Sub

Public Function ListFiles(FolderPath As String, Extension As String)
    Dim i As Long
    Dim FolderName As String
    Dim DirNames() As String
    Dim SubDirectories As Long
    
    '~~> List files in the main/first folder
    On Error Resume Next
    FolderName = Dir(FolderPath & "\" & Extension, vbDirectory)
    On Error GoTo 0
    
    
    Do While FolderName <> vbNullString
        j = j + 1
        ReDim Preserve MYFileArray(j)
        MYFileArray(j) = FolderPath & "\" & FolderName
        FolderName = Dir()
    Loop
    
    '~~> Get the sub directories
    On Error Resume Next
    FolderName = Dir(FolderPath & "\*.*", vbDirectory)
    On Error GoTo 0

    Do While FolderName <> vbNullString
        If FolderName <> "." And FolderName <> ".." Then
            SubDirectories = SubDirectories + 1
            ReDim Preserve DirNames(1 To SubDirectories)
            DirNames(SubDirectories) = FolderName
        End If
        FolderName = Dir()
    Loop

    For i = 1 To SubDirectories
        ListFiles FolderPath & "\" & DirNames(i), Extension
    Next i
End Function

Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

Open in new window


Sid
0
 
Rory ArchibaldCommented:
Just a quick check - did you need to open them in order? (i.e Week 01 first, then Week 02 etc)
0
 
gabrielPennybackAuthor Commented:
Hi Sid and Rory, thanks for posting. I can try this out at work tomorrow. I don't think the weeks have to be in order, I'm not sure.

- John
0
 
SiddharthRoutCommented:
The code I gave doesn't open the file in sequential order. As far as I could understand from your query, it's ok if the files are opened in any order?

Sid
0
 
gabrielPennybackAuthor Commented:
Thanks, Sid. Sorry for the delay.

- John
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now