Excel script help. Getting files in one folder

Posted on 2011-10-14
Last Modified: 2012-05-12
The code I have listed below works perfectly except for one detail and I cant see why it is failing. It should pick all excel files from the chosen folder and all folders below it and combine them. The code WILL combine workbooks that are in sub-directories under the chosen file path, but it ignores workbooks in the chosen folder.

I need this code to be used either way. Some of the data it is pulling may or may not be in a sub folder.

Any suggestions on whats wrong and how to fix it ?

' Phase 1- Getting it to combine files
' Code provided by andrewssd3 at
' Phase 2 - Give the option to provide a starting folder location
' Code provided By wobbled at
' Phase 3 - Get the code to grab both workbooks in sub folders, but also the primary folder

Option Explicit

Private mwbkMaster As Excel.Workbook     ' this totals workbook
Private mrngEQOut As Excel.Range         ' next available cell for totals for EQ
Private mrngLabOut As Excel.Range        ' next available cell for totals for Labor
Private mobjFSO As Object           'object        'Scripting.FileSystemObject
Public Sub ImportAll()

    Dim shtEQTot As Excel.Worksheet
    Dim shtLabTot As Excel.Worksheet

    Dim fldMaster As Object        'Scripting.Folder
    Dim fldSub As Object        'Scripting.Folder
    Dim filData As Object        'Scripting.File
    'Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
    Dim strFolder As String
    strFolder = GetFolder("")
    Set mwbkMaster = ThisWorkbook
    ' get the EQ totals sheet and find the first available row
    Set shtEQTot = mwbkMaster.Worksheets("EQ Totals")
    Set mrngEQOut = shtEQTot.UsedRange
    Set mrngEQOut = mrngEQOut.Offset(mrngEQOut.Rows.Count, 1).Resize(1, 1)
    ' get the Labor totals sheet and find the first available row
    Set shtLabTot = mwbkMaster.Worksheets("Labor Totals")
    Set mrngLabOut = shtLabTot.UsedRange
    Set mrngLabOut = mrngLabOut.Offset(mrngLabOut.Rows.Count, 1).Resize(1, 1)
    ' create the file system object
    Set mobjFSO = CreateObject("Scripting.FileSystemObject")
    ' find the master folder
    Set fldMaster = mobjFSO.GetFolder(strFolder)
    ' loop through all the sub folders
    For Each fldSub In fldMaster.SubFolders
        ' loop through all the files (should be only one?)
        For Each filData In fldSub.Files
            ' check it's some sort of Excel file and process it
            If LCase$(mobjFSO.GetExtensionName(filData.Name)) Like "xls*" Then
                Call ProcessFile(filData.Path)
            End If
        Next filData
    Next fldSub
    Set mrngEQOut = Nothing
    Set mrngLabOut = Nothing
    Set mobjFSO = Nothing
    MsgBox "Completed"
End Sub

Private Sub ProcessFile(ByVal strPath As String)
    ' called once for each workbook found
    Dim wbkIndiv As Excel.Workbook
    Dim wksCurrIn As Excel.Worksheet
    Dim rngIn As Excel.Range
    Dim strCaption As String            ' the name of the current input workbook
    Dim aData As Variant
    strCaption = mobjFSO.GetBaseName(strPath)
    ' open the data workbook
    Set wbkIndiv = Application.Workbooks.Open(Filename:=strPath, _
            UpdateLinks:=False, ReadOnly:=True, addtomru:=False)
    ' get the first sheet
    Set wksCurrIn = wbkIndiv.Worksheets("EQ Totals")
    ' get all data for this sheet into an array
    Set rngIn = wksCurrIn.UsedRange
    aData = rngIn.Value
    ' prepare the output range by making it the right size to receive the data
    Set mrngEQOut = mrngEQOut.Resize(rngIn.Rows.Count, rngIn.Columns.Count)
    ' put in the values from the input sheet
    mrngEQOut.Value = aData
    ' put in the label identifying this row
    mrngEQOut.Offset(0, -1).Resize(mrngEQOut.Rows.Count, 1).Value = strCaption
    ' get the next sheet (NB this is the same as the previous sheet - left separate
    ' in case something needs to change at a later point for one sheet
    Set wksCurrIn = wbkIndiv.Worksheets("Labor Totals")
    ' get all data for this sheet into an array
    Set rngIn = wksCurrIn.UsedRange
    aData = rngIn.Value
    ' prepare the output range by making it the right size to receive the data
    Set mrngLabOut = mrngLabOut.Resize(rngIn.Rows.Count, rngIn.Columns.Count)
    ' put in the values from the input sheet
    mrngLabOut.Value = aData
    ' put in the label identifying this row
    mrngLabOut.Offset(0, -1).Resize(mrngLabOut.Rows.Count, 1).Value = strCaption
    'move the output ranges on
    Set mrngEQOut = mrngEQOut.Offset(mrngEQOut.Rows.Count, 0)
    Set mrngLabOut = mrngLabOut.Offset(mrngLabOut.Rows.Count, 0)
    wbkIndiv.Saved = True
    ' close the data workbook
    Application.DisplayAlerts = False
    wbkIndiv.Close xlDoNotSaveChanges
    Application.DisplayAlerts = True
End Sub

Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
GetFolder = sItem
Set fldr = Nothing
End Function

Question by:RedstoneIT
    LVL 6

    Accepted Solution

    You're not processing the master folder's files. Add the following loop after     `Set fldMaster = mobjFSO.GetFolder(strFolder)`

            For Each fileInMasterFolder In fldMaster.Files
    		If LCase$(mobjFSO.GetExtensionName(fileInMasterFolder.Name)) Like "xls*" Then
    			Call ProcessFile(fileInMasterFolder.Path)
    		End If
    	Next fileInMasterFolder

    Open in new window


    Author Comment

    what is fileInMAsterFolder ? I get a variable not defined. Should  it be a string ?

    Author Comment

    found it. its a variant

    Thank you.

    Featured Post

    How to improve team productivity

    Quip adds documents, spreadsheets, and tasklists to your Slack experience
    - Elevate ideas to Quip docs
    - Share Quip docs in Slack
    - Get notified of changes to your docs
    - Available on iOS/Android/Desktop/Web
    - Online/Offline

    Join & Write a Comment

    Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
    Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
    This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
    This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

    746 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    16 Experts available now in Live!

    Get 1:1 Help Now