Question

获得

运行时间：错误编号9 下标超出范围

在这一行：

ReDim Preserve aryFileNames(UBound(aryFileNames) - 1)

在下面的代码中，用于将文本文件转换为特定文件夹中的Excel文件。

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

只要你的For Each循环没有执行或者你找不到任何文本文档，你就会得到一个超出范围的下标。数组的起始边界是0，在这种情况下它永远不会增加，所以这行代码...

ReDim Preserve aryFileNames(UBound(aryFileNames) - 1)

...正在尝试将数组的大小设置为-1的边界。由于您正在处理字符串，因此您可以利用Split函数中的一个怪癖来简化阵列大小调整。如果拆分vbNullString，VBA将返回一个UBound为-1的String数组。而不是用...初始化它。

ReDim aryFileNames(0)

...然后修剪它，你可以这样做：

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)

ReDim保留提升错误下标超出范围

1 个答案: