Read Files in folder Array function

[Singyt]

We have old Excel VBA function that creates an array of the files that are in a network folder. The files are then used in a report compiler to open and copy file contents into a big report. I am having an issue in getting the function to read the fold contents.

This was written by a former employee and we have just migrated from Excel 2007 to Excel 2013. I have trusted the document, location and added the VBA Analysis Toolpak - VBA Add in. So the code is running. My issue is the it does not read the files in the folder for some reason. I believe it's deriving the correct folder file path. Does anyone have any suggestions as I've stepped through it many times now and have no idea why it would not find anything.

If I bypass the "If Not UBound(ary) = 0 Then" line at the end of the function, I can get the code to find 1 of the files (the last one), but I'm still missing all 44 of the others.

Any help is appreciated.

Function FilesInFolder(FolderOrFiles As Variant) As Boolean
Dim FSO As Object ' FileSystemObject
Dim fsoFOL As Object ' Folder
Dim fsoFILE As Object ' File
Dim ary
    ReDim ary(0 To 0)
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fsoFOL = FSO.GetFolder(FolderOrFiles)
 
    For Each fsoFILE In fsoFOL.Files
        If Not fsoFILE.Path = ThisWorkbook.FullName Then
 
        'If fsoFILE.Type = "Microsoft Office Excel Worksheet" _
        'And Not fsoFILE.Path = ThisWorkbook.FullName Then
 
 
            ReDim Preserve ary(1 To UBound(ary) + 1)
            ary(UBound(ary)) = fsoFILE.Path
        End If
    Next
 
    If Not UBound(ary) = 0 Then
        FilesInFolder = True
        FolderOrFiles = ary
    End If
End Function

 

[AlphaFrog]

Can you show how you call the function and the declarations of the variables used in the calling procedure?

 

[Singyt]

Can you show how you call the function and the declarations of the variables used in the calling procedure?

Sorry for the slow reply. Code always seems to break when you have to be out of the office for a couple of days, right? I am out for Friday, but I will try to check in on this post often as I hope to fix this code by Monday. I appreciate your help AlphaFrog.

The procedure starts with a sub that codes the initiation of the report generation. That short code is here:

Private Sub ZMFiles_Click()
    Dim strTim As Date, strHdr As String, dblSize As Double
    Dim cntrlWkbk As Workbook, cntrlWksht As Worksheet
    Dim RptDt As Date, Nme As String, City As String, State As String, Comment As String
    Dim SrcWkbk As String, dstWkbk As String
        
    Application.ScreenUpdating = False

    strTim = Now()
    Set cntrlWkbk = ActiveWorkbook
    Set cntrlWksht = cntrlWkbk.Worksheets(ActiveSheet.Name)
    cntrlWksht.Outline.ShowLevels RowLevels:=2
    
    RptDt = Range("RptDt")
    Nme = Range("Nme")
    City = Range("City")
    State = Range("State")
    Comment = Range("TitleComment")
    
    dstWkbk = Format(RptDt, "YYYY-MM ") & Nme & " " & City & "-" & State & Comment & "1.xlsx"
        
    Call Module1.ImportPress(cntrlWkbk.Name, dstWkbk)
    
    cntrlWksht.Activate
    'cntrlWkbk.Worksheets(cntrlWksht.Name).Range("G12").FormulaR1C1 = Format(Now() - strTim + #12:00:00 AM#, "hh:mm:ss")
    cntrlWksht.Outline.ShowLevels RowLevels:=1
    Application.ScreenUpdating = True
End Sub

This calls Module1.ImportPress. The declarations are as follows

Sub ImportPress(cntrlWkbk As String, DestWBk As String)
'Report Compile macro

Dim FileNameRng As Range, FolderOrFiles As Variant, OutptPath As String, RptPath As String, RptDt As Date, _
sourceTab, sht As Worksheet, Nme As String, City As String, State As String, Comment As String, ttlA1 As String, _
removeLft As Integer, sourceWBook As Workbook, FootBnrPath As Variant, rngCell As Range, strClear As String, _
i As Integer, x As Integer, t As Integer, y As Integer, replace As String, rngRefCell As Range, rngTitleLoc As String, cpyRange As String, _
hdrRow As String, InsertTitle As String, hrzAlign As String, yMax As Integer, arrOrder(1 To 50, 1 To 3) As String, rngHghlt As String, _
hghltColor As String, delCols As String, delRows As String, boldClr As String, sing_doub As String, sing_sing As String, _
singU As String, replHdr As String, strtHdr As String, rngHide As String, colhide As String, tstSkip As Integer, singO As String, _
boldLns As String, hpgbrks As String, vpgbrks As String, initLvl As Integer, lvlMods As String, rptHdrs As String, _
LvlMods2 As String, PagesW As Integer, PagesH As Integer, PgZoom As Integer, colWAdj As String, strTim As Date, orient As String, _
intOrnt As String, strOrnt As Variant, elapsTim As Date, prAvg As Double, cntCnt As Double, rngFHide As String, clrBrdrs As String, _
prntBttmUp As Integer, doubU As String, fframe As String, cntrlSht As String, z As Integer, strChk As String, ttlAlt As String, _
locAlt As String, rptCols As String



'Application.ScreenUpdating = False
    '// Attempt to get user to pick a folder.
    OutptPath = Range("OutptPath")
    FolderOrFiles = OutptPath
    ''Dialog Method 'SelectFolder("Select Folder to Run Weekly Report over")  ', "\\Hp67391281111\Choice\2009\")
    '// If user cancels, FolderOrFiles returns an empty string, and we bail...          //
    If FolderOrFiles = vbNullString Then MsgBox ("need output file path!"): Exit Sub
    '// add trailining reverse solidus                                                  //
    If Not Right(FolderOrFiles, 1) = "\" Then FolderOrFiles = FolderOrFiles & "\"
    '// If the function finds workbooks in the selected folder, it returns True, and    //
    '// passes back an array of filenames by reusing FolderOrFiles                      //


    cntrlSht = ActiveSheet.Name
    FootBnrPath = Range("FootBnrPath")
    RptPath = Range("RptPath")
    RptDt = Range("RptDt")
    Nme = Range("Nme")
    'RptPath = "C:"
    If RptPath = vbNullString Then MsgBox ("need report file path!"): Exit Sub
    If Not Right(RptPath, 1) = "\" Then RptPath = RptPath & "\"

    Application.DisplayAlerts = False
    Workbooks.Add.SaveAs Filename:= _
        RptPath & DestWBk, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'    Workbooks.Add.SaveAs Filename:= _
        "C:\Documents and Settings\bhershberger.CSC\Desktop\" & DestWBk, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True
    
    
    'DestWBook = Format(RptDt, "YYYY-MM ") & Nme & " " & City & "-" & State & Comment & "1.xlsx"
    'Set FileNameRng = ThisWorkbook.Worksheets(1).Range("FileNameRng")
    Set FileNameRng = Workbooks(cntrlWkbk).Worksheets(cntrlSht).Range("FileNameRng")
    'Windows("Report Generator.xlsm").Activate
    'Windows(DestWBook).Activate
        
        
'************ Create Index of Files for Report ***************
'****** Establishes Sheet Order and Partial Outputs **********
 z = 0
 strChk = "x"
    If FilesInFolder(FolderOrFiles) Then
        For i = LBound(FolderOrFiles) To UBound(FolderOrFiles)
            'MsgBox GetFilenameFromPath(FolderOrFiles(i))
            Set rngRefCell = Find_RangeR(GetFilenameFromPath(FolderOrFiles(i)), FileNameRng)
            If rngRefCell.Address <> "$XFD$999" Then
                For Each rngCell In rngRefCell.Cells
                        y = rngCell.Offset(0, -1)
                        strChk = strChk & Format(str(rngCell.Offset(0, -1)), "00") & "x"
                        yMax = IIf(y > yMax, y, yMax)
                        arrOrder(y, 1) = rngCell.Address
                        arrOrder(y, 2) = GetFilenameFromPath(FolderOrFiles(i))
                        arrOrder(y, 3) = FolderOrFiles(i)
                    Next rngCell
                Else
                z = UpdtList(cntrlWkbk, "Sheet1", nmObject:="TextBox1", _
                        Text:=GetFilenameFromPath(FolderOrFiles(i)), Count:=z) + 1
                End If
            Next i
        End If
 
    
'****** Run Through Index Created above to Create Report *******

The code continues with formatting details, but since the FilesInFolder function did not populate an array, the procedure ends.

 

[AlphaFrog]

Nothing jumps out as wrong or suspicious in the code.

As a test, can you run it using a local drive and path?

 

[Singyt]

Thanks, I'll try that. Is there any code updating or conversation or libraries needed to run old code on Excel 2013?

 

[AlphaFrog]

I don't think so.

 

[Singyt]

I have tried running locally on my Desktop and nothing changed. Also the new software version outputs some results in .xlsx, which I changed in the names in file list. But I tried reverting all of those back to .xls and nothing changed. Please let me know if you have any other ideas or tests I can conduct.

 

[AlphaFrog]

Does FilesInFolder return True or False?

[color=darkblue]Sub[/color] ImportPress(cntrlWkbk [color=darkblue]As[/color] [color=darkblue]String[/color], DestWBk [color=darkblue]As[/color] [color=darkblue]String[/color])
[color=green]'Report Compile macro[/color]

[color=darkblue]Dim[/color] FileNameRng [color=darkblue]As[/color] Range, FolderOrFiles [color=darkblue]As[/color] [color=darkblue]Variant[/color], OutptPath [color=darkblue]As[/color] [color=darkblue]String[/color], RptPath [color=darkblue]As[/color] [color=darkblue]String[/color], RptDt [color=darkblue]As[/color] [color=darkblue]Date[/color], _
sourceTab, sht [color=darkblue]As[/color] Worksheet, Nme [color=darkblue]As[/color] [color=darkblue]String[/color], City [color=darkblue]As[/color] [color=darkblue]String[/color], State [color=darkblue]As[/color] [color=darkblue]String[/color], Comment [color=darkblue]As[/color] [color=darkblue]String[/color], ttlA1 [color=darkblue]As[/color] [color=darkblue]String[/color], _
removeLft [color=darkblue]As[/color] [color=darkblue]Integer[/color], sourceWBook [color=darkblue]As[/color] Workbook, FootBnrPath [color=darkblue]As[/color] [color=darkblue]Variant[/color], rngCell [color=darkblue]As[/color] Range, strClear [color=darkblue]As[/color] [color=darkblue]String[/color], _
i [color=darkblue]As[/color] [color=darkblue]Integer[/color], x [color=darkblue]As[/color] [color=darkblue]Integer[/color], t [color=darkblue]As[/color] [color=darkblue]Integer[/color], y [color=darkblue]As[/color] [color=darkblue]Integer[/color], replace [color=darkblue]As[/color] [color=darkblue]String[/color], rngRefCell [color=darkblue]As[/color] Range, rngTitleLoc [color=darkblue]As[/color] [color=darkblue]String[/color], cpyRange [color=darkblue]As[/color] [color=darkblue]String[/color], _
hdrRow [color=darkblue]As[/color] [color=darkblue]String[/color], InsertTitle [color=darkblue]As[/color] [color=darkblue]String[/color], hrzAlign [color=darkblue]As[/color] [color=darkblue]String[/color], yMax [color=darkblue]As[/color] [color=darkblue]Integer[/color], arrOrder(1 [color=darkblue]To[/color] 50, 1 To 3) [color=darkblue]As[/color] [color=darkblue]String[/color], rngHghlt [color=darkblue]As[/color] [color=darkblue]String[/color], _
hghltColor [color=darkblue]As[/color] [color=darkblue]String[/color], delCols [color=darkblue]As[/color] [color=darkblue]String[/color], delRows [color=darkblue]As[/color] [color=darkblue]String[/color], boldClr [color=darkblue]As[/color] [color=darkblue]String[/color], sing_doub [color=darkblue]As[/color] [color=darkblue]String[/color], sing_sing [color=darkblue]As[/color] [color=darkblue]String[/color], _
singU [color=darkblue]As[/color] [color=darkblue]String[/color], replHdr [color=darkblue]As[/color] [color=darkblue]String[/color], strtHdr [color=darkblue]As[/color] [color=darkblue]String[/color], rngHide [color=darkblue]As[/color] [color=darkblue]String[/color], colhide [color=darkblue]As[/color] [color=darkblue]String[/color], tstSkip [color=darkblue]As[/color] [color=darkblue]Integer[/color], singO [color=darkblue]As[/color] [color=darkblue]String[/color], _
boldLns [color=darkblue]As[/color] [color=darkblue]String[/color], hpgbrks [color=darkblue]As[/color] [color=darkblue]String[/color], vpgbrks [color=darkblue]As[/color] [color=darkblue]String[/color], initLvl [color=darkblue]As[/color] [color=darkblue]Integer[/color], lvlMods [color=darkblue]As[/color] [color=darkblue]String[/color], rptHdrs [color=darkblue]As[/color] [color=darkblue]String[/color], _
LvlMods2 [color=darkblue]As[/color] [color=darkblue]String[/color], PagesW [color=darkblue]As[/color] [color=darkblue]Integer[/color], PagesH [color=darkblue]As[/color] [color=darkblue]Integer[/color], PgZoom [color=darkblue]As[/color] [color=darkblue]Integer[/color], colWAdj [color=darkblue]As[/color] [color=darkblue]String[/color], strTim [color=darkblue]As[/color] [color=darkblue]Date[/color], orient [color=darkblue]As[/color] [color=darkblue]String[/color], _
intOrnt [color=darkblue]As[/color] [color=darkblue]String[/color], strOrnt [color=darkblue]As[/color] [color=darkblue]Variant[/color], elapsTim [color=darkblue]As[/color] [color=darkblue]Date[/color], prAvg [color=darkblue]As[/color] [color=darkblue]Double[/color], cntCnt [color=darkblue]As[/color] [color=darkblue]Double[/color], rngFHide [color=darkblue]As[/color] [color=darkblue]String[/color], clrBrdrs [color=darkblue]As[/color] [color=darkblue]String[/color], _
prntBttmUp [color=darkblue]As[/color] [color=darkblue]Integer[/color], doubU [color=darkblue]As[/color] [color=darkblue]String[/color], fframe [color=darkblue]As[/color] [color=darkblue]String[/color], cntrlSht [color=darkblue]As[/color] [color=darkblue]String[/color], z [color=darkblue]As[/color] [color=darkblue]Integer[/color], strChk [color=darkblue]As[/color] [color=darkblue]String[/color], ttlAlt [color=darkblue]As[/color] [color=darkblue]String[/color], _
locAlt [color=darkblue]As[/color] [color=darkblue]String[/color], rptCols [color=darkblue]As[/color] [color=darkblue]String[/color]



[color=green]'Application.ScreenUpdating = False[/color]
    [color=green]'// Attempt to get user to pick a folder.[/color]
    OutptPath = Range("OutptPath")
    FolderOrFiles = OutptPath
    [color=green]''Dialog Method 'SelectFolder("Select Folder to Run Weekly Report over")  ', "\\Hp67391281111\Choice\2009\")[/color]
    [color=green]'// If user cancels, FolderOrFiles returns an empty string, and we bail...          //[/color]
    [color=darkblue]If[/color] FolderOrFiles = vbNullString [color=darkblue]Then[/color] MsgBox ("need output file path!"): [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=green]'// add trailining reverse solidus                                                  //[/color]
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Right(FolderOrFiles, 1) = "\" [color=darkblue]Then[/color] FolderOrFiles = FolderOrFiles & "\"
    [color=green]'// If the function finds workbooks in the selected folder, it returns True, and    //[/color]
    [color=green]'// passes back an array of filenames by reusing FolderOrFiles                      //[/color]


    cntrlSht = ActiveSheet.Name
    FootBnrPath = Range("FootBnrPath")
    RptPath = Range("RptPath")
    RptDt = Range("RptDt")
    Nme = Range("Nme")
    [color=green]'RptPath = "C:"[/color]
    [color=darkblue]If[/color] RptPath = vbNullString [color=darkblue]Then[/color] MsgBox ("need report file path!"): [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Right(RptPath, 1) = "\" [color=darkblue]Then[/color] RptPath = RptPath & "\"

    Application.DisplayAlerts = [color=darkblue]False[/color]
    Workbooks.Add.SaveAs Filename:= _
        RptPath & DestWBk, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=[color=darkblue]False[/color]
[color=green]'    Workbooks.Add.SaveAs Filename:= _
        "C:\Documents and Settings\bhershberger.CSC\Desktop\" & DestWBk, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False[/color]
    Application.DisplayAlerts = [color=darkblue]True[/color]
    
    
    [color=green]'DestWBook = Format(RptDt, "YYYY-MM ") & Nme & " " & City & "-" & State & Comment & "1.xlsx"[/color]
    [color=green]'Set FileNameRng = ThisWorkbook.Worksheets(1).Range("FileNameRng")[/color]
    [color=darkblue]Set[/color] FileNameRng = Workbooks(cntrlWkbk).Worksheets(cntrlSht).Range("FileNameRng")
    [color=green]'Windows("Report Generator.xlsm").Activate[/color]
    [color=green]'Windows(DestWBook).Activate[/color]
        
        
[color=green]'************ Create Index of Files for Report ***************[/color]
[color=green]'****** Establishes Sheet Order and Partial Outputs **********[/color]
 z = 0
 strChk = "x"
 
'Test
[B] strPath$ = FolderOrFiles
 MsgBox FilesInFolder(FolderOrFiles) & vbLf & _
        vbLf & "Path: " & strPath, , _
        "FilesInFolder: True Or False?"[/B]
 
    [color=darkblue]If[/color] FilesInFolder(FolderOrFiles) [color=darkblue]Then[/color]