title: Macros vba to list all inaccessible network folders
body: <p>I have a vba code that scans a folder and its subdirectories for excel files and lists the connection strings and sql command. But my problem is my program doesn't list the inaccessible network folders that gives you the error "Access Denied." I wanna be able to list the path to the folder and indicate on the second column that the folder is inaccessible. How should I code it? I'm thinking</p>
  
  <pre><code>    On Error GoTo Handler
  Handler:
      If Err.Number = x Then
          oRng.Value = sFDR &amp; sItem
          oRng.Offset(0, 1).Value = "Inaccessible folder"
          Resume Next
      End If
  </code></pre>
  
  <p>But this code doesn't work. It doesn't specify the path of the 'access denied' folder at all. Instead, it puts the text "Inaccessible folder" to the next accessible excel file it sees.</p>
  
  <p>Here's the code:</p>
  
  <pre><code>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 &amp; " 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 &amp; sItem
          oRng.Offset(0, 1).Value = "Inaccessible folder"
          Resume Next
      End If
      For Each oFDR In oFSO.GetFolder(sFDR).SubFolders
      ListFolder oFDR.Path &amp; "\" ' 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 &amp; sItem
          oRng.Offset(0, 1).Value = "Inaccessible folder"
          Resume Next
      End If
      sItem = Dir(sFDR &amp; sFilter)
      Do Until sItem = ""
          N = N + 1 ' Increment Counter
          oRng.Value = sFDR &amp; 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: " &amp; sFile
      On Error Resume Next
      Set oWB = Workbooks.Open(Filename:=sFile, ReadOnly:=True, UpdateLinks:=False, Password:=userpass)
      If Err.Number &gt; 0 Then
          oRng.Offset(0, 1).Value = "Password protected file"
      Else
      With oWB
          For Each oConn In .Connections
              If Len(sConn) &gt; 0 Then sConn = sConn &amp; vbLf
              If Len(sCMD) &gt; 0 Then sCMD = sCMD &amp; vbLf
              sConn = sConn &amp; oConn.ODBCConnection.Connection
              sCMD = sCMD &amp; 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
  </code></pre>