Link to home
Start Free TrialLog in
Avatar of RedstoneIT
RedstoneIT

asked on

Excel script help. Getting files in one folder

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 https://www.experts-exchange.com
' Phase 2 - Give the option to provide a starting folder location
' Code provided By wobbled at https://www.experts-exchange.com
' 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
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function



ASKER CERTIFIED SOLUTION
Avatar of theKashyap
theKashyap

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of RedstoneIT
RedstoneIT

ASKER

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

Thank you.