Question

我在VBA中创建了一个宏，用于检查excel表上的部件号与文件目录中部件的文件名。脚本是这样的：

Sub scanDirectory()

    Dim path As String
    Dim currentPath As String
    Dim nameOfFile As String
    Dim counterA As Integer
    Dim success As Integer
    Dim endTester As String
    Dim draw As Integer
    'put the path to your folder here along with an \
    path = "\C:\Users\joe.blow\Documents\"

    counterA = 8
    Do Until counterA > 4294
        nameOfFile = Sheets("Sheet0").Cells(counterA, 2)

        currentPath = Dir(path)
        success = 0
        draw = 0
        Do Until currentPath = vbNullString
            Debug.Print currentPath

            'Success for Model
            endTester = nameOfFile + ".SLDPRT"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 5) = "Y"
                success = 1
            End If
            endTester = nameOfFile + ".sldprt"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 5) = "Y"
                success = 1
            End If

            'Success for Assembly
            endTester = nameOfFile + ".SLDASM"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 5) = "Y"
                success = 1
            End If

            'Succees for Drawing
            endTester = nameOfFile + ".SLDDRW"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 6) = "Y"
                draw = 1
            End If
            endTester = nameOfFile + ".slddrw"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 6) = "Y"
                draw = 1
            End If

            If draw = 0 Then
                Sheets("Sheet0").Cells(counterA, 6) = "N"
            End If

            If success = 0 Then
                Sheets("Sheet0").Cells(counterA, 5) = "N"
            End If

            currentPath = Dir()
        Loop
    counterA = counterA + 1
    Loop  'NextLine' End Sub

它的工作方式是逐行，检查每个单元格与整个文件树，检查文件扩展名的每个排列。然后，如果文件存在或没有相应的“Y”或“N”，则放入空列。它同时使用模型和绘图。

它适用于数据集<100;但我的列表有时长达9000多个项目。当我在那些较长的纸张上运行它时，它将运行良好约5秒，然后变得无响应和（无响应）。如果我等待很长时间＆gt; 1小时，那么它将完成运行，即使它是“无响应”。有没有更好的方法来运行它，以便它不会花费很长时间或

Answer 1

通过使用内置的FileSystemObject，您可以直接检查给定路径中是否存在文件，因此无需遍历每个单元格的文件列表。

给它一个旋转，看它是否有帮助，显着缩短代码，提高可读性并使处理器更少工作：）

Option Explicit

Sub scanDirectory()

    Application.ScreenUpdating = False

    Dim path As String
    'put the path to your folder here along with an \
    path = "\C:\Users\joe.blow\Documents\"

    Dim counterA As Integer
    counterA = 8

    Do Until counterA > 4294

        'grab file name from cell
        Dim nameOfFile As String
        nameOfFile = Sheets("Sheet0").Cells(counterA, 2)

        Dim fso As New FileSystemObject 'be sure to check Microsoft Scripting Runtime in Tools > References

        'check for Drawing
        Sheets("Sheet0").Cells(counterA, 6).Value = IIf(fso.FileExists(path + nameOfFile + ".SLDDRW"), "Y", "N")

        'check for Model or Assembly
        Dim maCheck As Boolean
        If fso.FileExists(path + nameOfFile + ".SLDPRT") Or fso.FileExists(path + nameOfFile + ".SLDASM") Then maCheck = True

        Sheets("Sheet0").Cells(counterA, 5).Value = IIf(maCheck, "Y", "N")
        maCheck = False

        counterA = counterA + 1

    Loop  'NextLine

End Sub

Excel VBA循环适用于小型数据集，但对于较大的数据集则需要指数级增长

1 个答案: