Question

我有一个vba代码，用于扫描excel文件的文件夹及其子目录，并列出连接字符串和sql命令。但我的问题是我的程序没有列出无法访问的网络文件夹，给你错误“访问被拒绝”。我想能够列出文件夹的路径，并在第二列上指出该文件夹不可访问。我应该如何编码呢？我在想

    On Error GoTo Handler
Handler:
    If Err.Number = x Then
        oRng.Value = sFDR & sItem
        oRng.Offset(0, 1).Value = "Inaccessible folder"
        Resume Next
    End If

但是这段代码不起作用。它根本没有指定'access denied'文件夹的路径。相反，它将文本“Inaccessible文件夹”放到它看到的下一个可访问的excel文件中。

以下是代码：

Private Const FILE_FILTER = "*.xl*"
Private Const sRootFDR = "Path" ' Root Folder

Private oFSO As Object ' For FileSystemObject
Private oRng As Range, N As Long ' Range object and Counter

Sub Main()
    Application.ScreenUpdating = False
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    N = 0
    With ThisWorkbook.Worksheets("Sheet1")
        .UsedRange.ClearContents ' Remove previous contents
        .Range("A1:E1").Value = Array("Filename", "Connections", "Connection String", "Command Text", "Date Scanned")
        Set oRng = .Range("A2") ' Initial Cell to start storing results
    End With
    Columns("A:E").Select
    With Selection
        .WrapText = True
        .ColumnWidth = 45
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
    ListFolder sRootFDR
    Application.ScreenUpdating = True
    Set oRng = Nothing
    Set oFSO = Nothing
    Columns.AutoFit
    MsgBox N & " Excel files has been checked for connections."
End Sub

Private Sub ListFolder(ByVal sFDR As String)
    Dim oFDR As Object
    ' List the files of this Directory
    ListFiles sFDR, FILE_FILTER
    ' Recurse into each Sub Folder
    On Error GoTo Handler
Handler:
    If Err.Number = 5 Then
        oRng.Value = sFDR & sItem
        oRng.Offset(0, 1).Value = "Inaccessible folder"
        Resume Next
    End If
    For Each oFDR In oFSO.GetFolder(sFDR).SubFolders
    ListFolder oFDR.Path & "\" ' Need '\' to ensure the file filter works
    Next
End Sub

Private Sub ListFiles(ByVal sFDR As String, ByVal sFilter As String)
    Dim sItem As String
    On Error GoTo Handler
Handler:
    If Err.Number = 52 Then
        oRng.Value = sFDR & sItem
        oRng.Offset(0, 1).Value = "Inaccessible folder"
        Resume Next
    End If
    sItem = Dir(sFDR & sFilter)
    Do Until sItem = ""
        N = N + 1 ' Increment Counter
        oRng.Value = sFDR & sItem
        CheckFileConnections oRng.Value ' Call Sub to Check the Connection settings
        oRng.Offset(0, 4) = Now
        Set oRng = oRng.Offset(1) ' Move Range object to next cell below
        sItem = Dir
    Loop
End Sub

Private Sub CheckFileConnections(ByVal sFile As String)
    Dim oWB As Workbook, oConn As WorkbookConnection
    Dim sConn As String, sCMD As String
    Dim ConnectionNumber As Integer
    ConnectionNumber = 1
    Application.StatusBar = "Opening workbook: " & sFile
    On Error Resume Next
    Set oWB = Workbooks.Open(Filename:=sFile, ReadOnly:=True, UpdateLinks:=False, Password:=userpass)
    If Err.Number > 0 Then
        oRng.Offset(0, 1).Value = "Password protected file"
    Else
    With oWB
        For Each oConn In .Connections
            If Len(sConn) > 0 Then sConn = sConn & vbLf
            If Len(sCMD) > 0 Then sCMD = sCMD & vbLf
            sConn = sConn & oConn.ODBCConnection.Connection
            sCMD = sCMD & oConn.ODBCConnection.CommandText

            oRng.Offset(0, 1).Value = ConnectionNumber ' 1 column to right (B)
            oRng.Offset(0, 2).Value = oConn.ODBCConnection.Connection ' 2 columns to right (C)
            oRng.Offset(0, 3).Value = oConn.ODBCConnection.CommandText ' 3 columns to right (D)
            ConnectionNumber = ConnectionNumber + 1
            Set oRng = oRng.Offset(1) ' Move Range object to next cell below
        Next
    End With
    End If
    oWB.Close False ' Close without saving
    Set oWB = Nothing
    Application.StatusBar = False
End Sub

Answer 1

嗯，我尝试调试你的代码并找到了以下内容。

您的错误处理程序编码有点傻。如果处理程序被触发，但错误代码不是您正在测试的那个，那么您将从start开始重新调用循环。将它们编码为更简洁：

Private Sub ListFolder(ByVal sFDR As String)
    Dim oFDR As Object, lFDR As Object
    ' List the files of this Directory
    ListFiles sFDR, FILE_FILTER
    ' Recurse into each Sub Folder
    On Error GoTo Handler
    For Each oFDR In oFSO.GetFolder(sFDR).SubFolders
        ListFolder oFDR.Path & "\" ' Need '\' to ensure the file filter works
    Next
    Exit Sub
Handler:
    If Err.Number = 70 Then
        oRng.Value = sFDR
        oRng.Offset(0, 1).Value = "Inaccessible folder - access denied"

    End If
    Resume Next
End Sub

这可确保您为触发处理程序的所有错误执行Resume Next，而不仅仅是您要查找的一个错误。我知道对于ListFiles（）子，重新进入循环应该可以正常工作，但它仍然是不好的形式。并且该代码格式不适用于ListFolder（）子，因为它会导致硬中止。

当我如图所示更改了ListFolder（并将Err.Number更改为70）时，您的代码似乎对我有效。我制作了两个无法访问的文件和文件夹，并显示了正确的错误标记，其中包含我无法访问的正确文件名和目录名。

宏vba列出所有无法访问的网络文件夹

1 个答案: