映射网络驱动器遍历子文件夹时遇自动化网络错误求解决

错误信息 #

自动化错误 - 发生意外网络错误

问题场景 #

遍历映射网络驱动器的子文件夹时触发上述错误，但本地C:\驱动器下运行FindFolder函数完全正常，错误出现在代码的For Each subfolder In folder.SubFolders行。

相关代码 #

Function FindFolder(ByVal strStartFolder As String, ByVal strFolderNamePattern As String) As String

  Dim fso As Object, folder As Object, subfolder As Object

  Set fso = CreateObject("Scripting.FileSystemObject")

  On Error Resume Next 

  Set folder = fso.GetFolder(strStartFolder)

  On Error GoTo 0

  If folder Is Nothing Then
    FindFolder = "" 
    Exit Function
  End If


  'Check the current folder first
  If FolderMatchesPattern(folder.Name, strFolderNamePattern) Then
    FindFolder = folder.Path
    Exit Function
  End If

  'Recursively search subfolders
  For Each subfolder In folder.SubFolders
    FindFolder = FindFolder(subfolder.Path, strFolderNamePattern) 
    If FindFolder <> "" Then 
      Exit Function
    End If
  Next subfolder

  FindFolder = "" 
  Set fso = Nothing 
  Set folder = Nothing
  Set subfolder = Nothing

End Function

解决方法 #

1. 给遍历子文件夹的逻辑添加错误捕获 #

网络驱动器常遇到权限不足、连接中断或文件夹不可访问的情况，原代码遍历folder.SubFolders时无错误处理，一旦触发异常就直接报错。修改遍历部分代码，加入错误捕获：

'Recursively search subfolders
Dim subFolders As Object
On Error Resume Next
Set subFolders = folder.SubFolders
On Error GoTo 0

If Not subFolders Is Nothing Then
  For Each subfolder In subFolders
    On Error Resume Next
    FindFolder = FindFolder(subfolder.Path, strFolderNamePattern) 
    On Error GoTo 0
    If FindFolder <> "" Then 
      Exit Function
    End If
  Next subfolder
End If

这样即便某个子文件夹无法访问，代码也能跳过它继续遍历其他目录。

2. 用UNC路径替代映射驱动器 #

映射驱动器可能因用户会话、权限映射等问题出现不稳定，直接使用UNC路径（比如\\服务器名\共享目录）代替驱动器号（比如Z:\），能规避很多映射相关的问题，调用函数时传入UNC路径即可。

3. 检查网络驱动器的权限与连接状态 #

• 确认当前用户对网络驱动器下所有子文件夹拥有读取权限，部分文件夹可能设置了访问限制，导致FSO无法读取。
• 手动访问网络驱动器，确认连接正常，没有断开或需要重新认证的情况。

4. 添加延迟重试机制（可选） #

如果网络连接不稳定，可在捕获错误后短暂延迟再重试：

'Recursively search subfolders
For Each subfolder In folder.SubFolders
  On Error Resume Next
  FindFolder = FindFolder(subfolder.Path, strFolderNamePattern)
  If Err.Number <> 0 Then
    Err.Clear
    '延迟1秒后重试一次
    Application.Wait Now + TimeValue("00:00:01")
    FindFolder = FindFolder(subfolder.Path, strFolderNamePattern)
  End If
  On Error GoTo 0
  If FindFolder <> "" Then 
    Exit Function
  End If
Next subfolder

内容的提问来源于stack exchange，提问作者Luke Kirby