使用数组将文件名传输到具有多个工作表的工作簿中

Question

    Public Sub GetSOPFiles()
    '   Set folder path
        Const FolderPath As String = "C:\Users\test\Desktop\SOP Audit Excel Prototype"

        Const FileExt As String = "docx"

        Dim Result As Variant
        Dim i As Integer
        Dim MyFile As Object
        Dim MyFSO As Object
        Dim MyFolder As Object
        Dim MyFiles As Object
        Dim dept As Variant
        Dim deptCodes() As Variant

        Set MyFSO = CreateObject("Scripting.FileSystemObject")
        Set MyFolder = MyFSO.GetFolder(FolderPath)
        Set MyFiles = MyFolder.Files

    '   Research built-in Result function in VBA
        ReDim Result(1 To MyFiles.Count)

        Dim vData As Variant
        Dim sTemp As Variant

    '   Use a For loop to loop through the total number of sheets
        For i = 1 To 12
    '       Setup Select to determine dept values
            Select Case i

                Case 1
                    deptCodes = Array("PNT", "VLG", "SAW")

                Case 2
                    deptCodes = Array("CRT", "AST", "SHP", "SAW")

                Case 3
                    deptCodes = Array("CRT", "STW", "CHL", "ALG", "ALW", "ALF", "RTE", "AFB", "SAW")

                Case 4
                    deptCodes = Array("SCR", "THR", "WSH", "GLW", "PTR", "SAW")

                Case 5
                    deptCodes = Array("PLB", "SAW")

                Case 6
                    deptCodes = Array("DES")

                Case 7
                    deptCodes = Array("AMS")

                Case 8
                    deptCodes = Array("EST")

                Case 9
                    deptCodes = Array("PCT")

                Case 10
                    deptCodes = Array("PUR", "INV")

                Case 11
                    deptCodes = Array("SAF")

                Case 12
                    deptCodes = Array("GEN")
            End Select

'       Loop through files in directory
        j = 0
        For Each MyFile In MyFiles
'           Limit files by file extension
            If InStr(1, MyFile.Name, FileExt) <> 0 Then
'               Explode file name into array and only pull files with defined dept codes
                Dim toSplitFileName As Variant
                toSplitFileName = Split(MyFile.Name, "-")
                For Each dept In deptCodes
                    If dept = toSplitFileName(3) Then
                        ReDim Preserve Result(0 To j)
                        Result(j) = MyFile.Name
                        j = j + 1
                    End If
                Next dept
            End If
        Next MyFile
'       Send array to worksheet
        Range("A1:A20").Value = Application.WorksheetFunction.Transpose(Result)
    Next

    End Sub

好的，关于超范围部分，您是正确的。我编辑了代码并将其发布。

我要在这里执行的操作是提取文件名，在解析文件名后对它们进行排序（使用SELECT定义我要查找的不同值），然后将这些文件名作为数组传输到工作簿。

我有一个正在运行的（有点）功能，它确实很慢，所以在这里收到一些建议后，将结果发送到数组，然后使用VBA直接转移到工作表。这是我到目前为止所拥有的。

我正在尝试弄清楚如何将数据发送到每张纸...我将其工作在一张纸上。说它循环并找到SELECT案例1的所有文件，然后将所有这些文件名发送到工作表1的A列。与案例2相同，等等。

此刻，它只是一次又一次地用一个文件名填充定义范围内的所有单元格。

喜欢...

感谢所有堆栈溢出！到目前为止，在购买了3本书并撰写了几篇文章之后，我觉得我已经开始在VBA中取得一些进展。仍然有很多东西要学习。