ReDim保留引发错误下标超出范围

Question

Getting a

Run-time : Error No. 9
Subscript out of range

at the line:

ReDim Preserve aryFileNames(UBound(aryFileNames) - 1) 

In the code below which is meant to convert text files to Excel files in a particular folder.

Sub ConvertTextFiles()
    Dim fso As Object '<---FileSystemObject
    Dim fol As Object '<---Folder
    Dim fil As Object '<---File
    Dim strPath As String
    Dim aryFileNames As Variant
    Dim i As Long
    Dim wbText As Workbook

    Application.ScreenUpdating = False
    '// I am assuming the textfiles are in the same folder as the workbook with //
    '// the code are. //
    strPath = ThisWorkbook.Path & Application.PathSeparator

    '// Set a reference to the folder using FSO, so we can use the Files collection.//
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fol = fso.GetFolder(strPath)

    '// Using FSO's Files collection, we'll run through and build an array of //
    '// textfile names that exist in the folder. //
    ReDim aryFileNames(0)
    For Each fil In fol.Files
        If fil.Type = "Text Document" Then
            '// If correct Type (a text file), we'll assign the name of the found //
            '// textfile to the last element in the array - then add an empty //
            '// element to the array for next loop around... //
            aryFileNames(UBound(aryFileNames)) = fil.Name
            ReDim Preserve aryFileNames(UBound(aryFileNames) + 1)
        End If
    Next
    '// ... now since we were adding an empty element to the array, that means we'll//
    '// have an emmpty ending element after the above loop -  get rid of it here. //
    ReDim Preserve aryFileNames(UBound(aryFileNames) - 1)

    '// Basically, For Each element in the array... //
    For i = LBound(aryFileNames) To UBound(aryFileNames)
        '// ...open the textfile, set a reference to it, SaveAs and Close. //
        Workbooks.OpenText Filename:=strPath & aryFileNames(i), _
        Origin:=xlWindows, _
        StartRow:=1, _
        DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), _
        Array(7, 1), _
        Array(55, 1), _
        Array(68, 1))
        Set wbText = ActiveWorkbook
        wbText.Worksheets(1).Columns("A:D").EntireColumn.AutoFit
        wbText.SaveAs Filename:=strPath & Left(aryFileNames(i), Len(aryFileNames(i)) - 4), _
        FileFormat:=xlWorkbookNormal

        wbText.Close
    Next
    Application.ScreenUpdating = True
End Sub 

Answer 1

You'll get a subscript out of range any time your For Each loop doesn't execute or you don't find any text documents. The starting bound of the array is 0 and in that case it never gets incremented, so this line of code...

ReDim Preserve aryFileNames(UBound(aryFileNames) - 1) 

...is trying to size the array to a bound of -1. Since you're working with strings, you can take advantage of a quirk in the Split function to simplify your array sizing. If you Split a vbNullString, VBA will return a String array with a UBound of -1. Instead of initializing it with ...

ReDim aryFileNames(0)

... and then trimming it afterward, you can just do this:

aryFileNames = Split(vbNullString)
'UBound of the array is now -1.
For Each fil In fol.Files
    If fil.Type = "Text Document" Then
        ReDim Preserve aryFileNames(UBound(aryFileNames) + 1)
        aryFileNames(UBound(aryFileNames)) = fil.Name
    End If
Next
'Array is correct size - you can skip "trimming" it.
'ReDim Preserve aryFileNames(UBound(aryFileNames) - 1)