Question

我编写了代码，将所有文件夹和子文件夹的名称以及每个文件夹的文件数写入表中。我在另一个表中有三个映射驱动器，并使用该表中映射的驱动器号加载一个数组，然后遍历该表中列出的所有驱动器以填充该列表。

在为写入执行大量操作后，它总是崩溃。它似乎与空文件夹没有任何关系（有许多已列为＆＃34; 0＆＃34;文件。甚至它崩溃的文件夹名称也不常见。它没有＆＃39 ;每次都必须在同一个文件夹上崩溃，而不是在写入一定数量的行之后。我已经尝试更改表中驱动器的顺序，看它是否总是在同一个驱动器上失败，但是事实并非如此，它始终在第一次驱动期间失败，无论哪个驱动器是第一个（T：\，R：\，S :)。在某些时候，它总是在代码上崩溃＆＃ 34; Filename = Dir（Mypath）＆＃34;。它将Filename显示为空，但Mypath显示正确的当前路径。

以上是上次崩溃的目录名称：＆＃34; T：\ 05。网络和IT安全转型计划\ 03。商业案例和战略文件＆＃34;，所以没有什么不寻常的。该文件夹为空，没有任何隐藏。属性设置为显示隐藏文件，文件夹等。

以下是代码：

Sub ListMyDir()
'This updates the tables in the "Starting Directory List" so they can be used in the drop down menus
'on the other worksheets to select a starting directory to list files from
'Setup display defaults
'    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = True
    Application.StatusBar = "Importing Beehive Folder Names"
'Setup variables
    Dim tblrow As Integer
    Dim myIndexTable As ListObject
    Dim MyArray As Variant
    Dim MyArrayPath As String
    Dim MyLibraryName As String
    Dim x As Integer
    Dim y As Long
    Dim Folders As Integer
    Dim mfiles As Integer
    Dim mypath As String
    Set myIndexTable = ActiveSheet.ListObjects("EA_Libraries_Data")
    y = myIndexTable.ListRows.Count
    MyArray = myIndexTable.DataBodyRange
    MsgBox "Number of Libraries:  " & y
'Set starting row number for table
        tblrow = 1
        Folders = 1
        myfiles = 0
'   On Error Resume Next
'Empty the existing table contents
        If ActiveSheet.ListObjects("EA_Directories").ListRows.Count > 0 Then
            ActiveSheet.ListObjects("EA_Directories").DataBodyRange.Delete
        End If
'Loop through list of tables
    For x = 1 To y
    'Set the starting path and the Library Name from the array
        MyLibraryName = MyArray(x, 1)
        MyArrayPath = MyArray(x, 2)
        MsgBox "My Library: " & MyLibraryName & "  Path:  " & MyArrayPath & "  Row:  " & tblrow
    'Call Subroutine for every instance of a new subfolder
        Call ListDirPath(MyArrayPath, MyLibraryName, tblrow, Folders, myfiles, mypath)
    Next x
'Sort Table
        Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Starting Directory List").ListObjects( _
        "EA_Directories").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Starting Directory List").ListObjects( _
        "EA_Directories").Sort.SortFields.Add Key:=Range( _
        "EA_Directories[[#All],[Folder]]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Starting Directory List").ListObjects( _
        "EA_Directories").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.StatusBar = ""
    Application.Calculation = xlCalculationAutomatic
End Sub
Sub ListDirPath(MyArrayPath, MyLibraryName, ByRef tblrow, ByRef Folders, ByRef myfiles, mypath)
'Get directory information
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(MyArrayPath)
'Add Path to table
        Application.StatusBar = "Importing Beehive Folder Names  " & Folders
        ActiveSheet.ListObjects("EA_Directories").ListRows.Add AlwaysInsert:=True
        ActiveSheet.ListObjects("EA_Directories").DataBodyRange(tblrow, 1).Value = MyLibraryName
        ActiveSheet.ListObjects("EA_Directories").DataBodyRange(tblrow, 2).Value = MyArrayPath
        mypath = MyArrayPath & "\*.*"
        Filename = Dir(mypath)
        myfiles = 0
        Do While Filename <> ""
            myfiles = myfiles + 1
            Filename = Dir()
        Loop
        ActiveSheet.ListObjects("EA_Directories").DataBodyRange(tblrow, 3).Value = myfiles
        tblrow = tblrow + 1
        Folders = Folders + 1
'Loop through all subdirectories
    If Error = 53 Then
       MsgBox Err & ": " & Error(Err) & "Path: " & MyArrayPath
    End If
'    On Error Resume Next
    For Each MySubfolder In mySource.SubFolders
        Call ListDirPath(MySubfolder.Path, MyLibraryName, tblrow, Folders, myfiles, mypath)
    Next
End Sub

思想？

列出所有文件夹和子文件夹以及计数文件

0 个答案: