LBound和UBound下标超出了已经工作了三年的阵列

Question

I have four of these almost identical to each other, they all worked this morning, now they don't.

I'm really at a loss. The only thing different was that someone other than me ran it.

Code stops at First = LBound(list) Hovering over First it reads " First = 0 " Over LBound(list) it reads " LBound(list)= <Subscript out of range> " Over Last it reads " Last = 0 " Over UBound(list) it reads " UBound(list = <Subscript out of range> "

Option Explicit
Private Sub Workbook_Open()

ActiveSheet.Unprotect Password:="Operator"

MsgBox "This will compile all the operator rounds in the Fire Pump Folder. Enjoy!" & vbNewLine & "Make Sure Your Macros Are Enabled."

Dim fPATH As String, fNAME As String
Dim LR As Long, NR As Long
Dim wbGRP As Workbook, wsDEST As Worksheet
Dim fileNames() As String, i As Long


Set wsDEST = ThisWorkbook.Sheets("Summary")
NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1

fPATH = "\\SMRT01-FPS-15\plant_information\Operator_Required_Rounds\FirePump\"       'remember the final \ in this string

fNAME = Dir(fPATH & "*.xls")        'get the first filename in fpath
i = 0
Do While Len(fNAME) > 0
        ReDim Preserve fileNames(i)
        fileNames(i) = fNAME
        i = i + 1
        fNAME = Dir
    Loop

If i >= 0 Then

    BubbleSort fileNames
    For i = 0 To UBound(fileNames)
        Set wbGRP = Workbooks.Open(fPATH & fileNames(i))   'open the file
        LR = wbGRP.Sheets("Fire Pump (Monday)").Range("B" & Rows.Count).End(xlUp).Row  'how many rows of info?
    If LR > 3 Then
        wsDEST.Range("A" & NR) = Replace(Range("A1"), "Group ", "")
        wbGRP.Sheets("Fire Pump (Monday)").Range("B3:F" & LR).Copy
        wsDEST.Range("B" & NR).PasteSpecial xlPasteAll
        NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1
    End If

    wbGRP.Close False   'close data workbook
Next

Range("A3:A" & NR - 1).SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
With Range("A3:A" & NR - 1)
    .Value = .Value
End With
 Else

        'fileNames array is empty
        MsgBox "No .xls files found in " & fPATH
End If

End Sub
Sub BubbleSort(list() As String)
'   Sorts an array using bubble sort algorithm
    Dim First As Integer, Last As Long
    Dim i As Long, j As Long
    Dim Temp

    First = LBound(list)
    Last = UBound(list)
    For i = First To Last - 1
        For j = i + 1 To Last
            If list(i) > list(j) Then
                 Temp = list(j)
                list(j) = list(i)
                list(i) = Temp
            End If
        Next j
    Next i
End Sub

Answer 1

The problem is in the BubbleSort declaration:

Sub BubbleSort(list() As String)

Which is saying to treat list() as a String type variable whereas an array is typically of type Variant. A Variant can hold a String or an array of Strings - a String can never hold an array and therefore won't have a Ubound.

Changing the BubbleSort declaration to:

Sub BubbleSort(list as Variant)

will work!

That said, elements of the fileNames() array, read into it using Dir , will be in ascending order anyway. Sorting fileNames() serves no purpose in this context and sorting them on every loop pass probably makes your loop imperceptibly slower.

If you still want to use BubbleSort, move it to before entering the loop so that it's only called once.

Answer 2

Based on your problem description and the code logic, I believe your issue is that
fNAME = Dir(fPATH & "*.xls")
is returning an empty string.

From Excel's built-in help:

Dir returns the first file name that matches pathname. To get any additional file names that match pathname, call Dir again with no arguments. When no more file names match, Dir returns a zero-length string (""). Once a zero-length string is returned, you must specify pathname in subsequent calls or an error occurs.

While the documentation does not explicitly state that calling Dir with a non-existent pathname will return an empty string, it is implied by the phrase "no more file names match".

Because of this, the array fileNames is left in an un-dimensioned state. An un-dimensioned array will result in the error you are observing from the LBound and UBound functions. Because of faulty code logic, the BubbleSort is being called with nothing to sort.

Change the following statements:

i = 0
Do While Len(fNAME) > 0
   ReDim Preserve fileNames(i)
   fileNames(i) = fNAME
   i = i + 1
   fNAME = Dir
Loop

to:

fNAME = Dir(fPATH & "*.xls")        'get the first filename in fpath
i = -1
Do While Len(fNAME) > 0
   i = i + 1
   ReDim Preserve fileNames(i)
   fileNames(i) = fNAME
   fNAME = Dir
Loop

This will allow the remainder of the code logic to function properly because the variable i will be -1 if no files are found when the following statement is evaluated.
If i >= 0 Then