Question

尝试创建文件数组，以后可以“循环遍历”以从每个文件中提取信息（文件在excel中以相同的方式布置/以表格形式）。收到“ 6”溢出错误，怀疑这是我的循环导致的错误吗？

Sub WorkOrderList()
'This compiles an array of Files by picking from the folder
Dim objFileDialog As Office.FileDialog
Dim SelectedFile As Variant
Dim arFiles() As Variant
Dim myCount As Integer
Set objFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = True
.ButtonName = "Select"
.Title = "Work Order Picker"
If (.Show > 0) Then
End If
If (.SelectedItems.Count > 0) Then
For Each SelectedFile In .SelectedItems
Do Until SelectedFile = ""
myCount = myCount + 1
ReDim Preserve arFiles(1 To myCount)
arFiles(myCount) = SelectedFile
Loop
Next SelectedFile
Else
End If
End With
Set objFileDialog = Nothing
End Sub

我希望得到一个结果数组arFiles，该数组的每个元素都是从msoFileDialogFilePicker中选择的文件。

Answer 1

您不需要像这样嵌套循环来复制它们。之所以会出现溢出，是因为您有一个Do循环，无法退出：

        For Each SelectedFile In .SelectedItems
            Do Until SelectedFile = ""      '<-- This will never be true.
                myCount = myCount + 1
                ReDim Preserve arFiles(1 To myCount)
                arFiles(myCount) = SelectedFile
            Loop
        Next SelectedFile

这将继续递增myCount直到溢出。鉴于数组的大小总是与所选项目的数量相同，我建议使用一个简单的For循环。一次调整数组大小（as @TimWilliams suggested），然后仅使用SelectedItems上的索引器复制它们：

    myCount = .SelectedItems.Count
    If myCount > 0 Then
        ReDim arFiles(1 To myCount)
        Dim idx As Long
        For idx = 1 To myCount
            arFiles(idx) = .SelectedItems(idx)
        Next
    End If

Answer 2

With objFileDialog
    .AllowMultiSelect = True
    .ButtonName = "Select"
    .Title = "Work Order Picker"
    .Show
    If (.SelectedItems.Count > 0) Then
        ReDim Preserve arFiles(1 To .SelectedItems.Count)
        For Each SelectedFile In .SelectedItems
            myCount = myCount + 1
            arFiles(myCount) = SelectedFile
        Next SelectedFile
    End If
End With

在msoFileDialogFilePicker之后从SelectedItems创建数组

2 个答案: