VBA Excel 在 UNC 路径上查找带有 DIR 的子文件夹 - DIR 出错

VBA Excel Find child folder with DIR on UNC Path - Error with DIR

第一次发帖,如有错误请见谅

我正在尝试循环遍历服务器文件夹(UNC 路径)以找到特定的子文件夹(项目文件夹)来保存工作簿(用户将通知与该文件夹相关的项目)。

我正在使用循环和 DIR() 函数,但出于某种原因 DIR() returns "."对于第一个文件夹循环和第二个循环 returns 第一个子文件夹。

StdPath = "\Server\Database$\ABC\"

'Find project folder

Dirloop1 = Dir(StdPath, vbDirectory) 'Should return the 1st child folder, instead returns "."

'Loop into folders until find the project folder speficied by the user
Do Until Dirloop1 = ""
If (GetAttr(StdPath & Dirloop1) And vbDirectory) = vbDirectory Then
    Dirloop2 = Dir(StdPath & Dirloop1, vbDirectory) 'This should indicate the 2nd child folder but instead is returning the 1st child folder
    Do Until Dirloop2 = ""
        If (GetAttr(StdPath & Dirloop1 & Dirloop2) And vbDirectory) = vbDirectory Then 'Error happens here since it didn't reach the second child folder
            If InStr(Dirloop2, ActiveSheet.Range("N7")) > 0 Then
                StdPath = StdPath & Dirloop1 & Dirloop2
                MsgBox StdPath
                Exit Do
            Else
                Dirloop2 = Dir()
            End If
        End If
    Loop
    If InStr(StdPath, ActiveSheet.Range("N7")) = 0 Then
        Exit Do
    End If

End If
Dirloop1 = Dir()
Loop

第一次使用编程,经验不多,如果有人能给我更好的解决方案,谢谢支持。

Rory 和 Comintern,感谢您的支持,我终于设法使用 FileSystemObject 做到了,实际上比 DIR() 语句容易得多。我必须先阅读它才能实现它,但结果还可以,代码如下。

Public FSO As New FileSystemObject
Sub ProjectFolder()
Dim Dirloop as Folder
Dim Dirloop2 as Folder

StdPath = "\Server\Database$\ABC\"

Set Dirloop = FSO.GetFolder(StdPath)

'Find Project Folder
For Each subfolder In Dirloop.SubFolders

Set Dirloop2 = FSO.GetFolder(subfolder.Path)

    For Each subfolder2 In Dirloop2.SubFolders
        If InStr(subfolder2.Path, ActiveSheet.Range("N7")) > 0 Then
            ProjectPath = subfolder2.Path
        End If
    Next
Next

If Len(ProjectPath) = 0 Then
    MsgBox "Folder not found. Please talk with Project Leader"
    Exit Sub
End If
' Rest of the code below

再次感谢您的帮助。