Question

这是我第一次发帖，抱歉有任何错误。

我正在尝试通过服务器文件夹（UNC Path）循环查找特定的子文件夹（项目文件夹）以保存工作簿（用户将通知与该文件夹相关的项目）。

我正在使用循环和DIR（）函数，但由于某种原因，DIR（）返回“。”对于第一个文件夹循环和第二个循环返回第一个子文件夹。

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

这是我第一次使用编程因此没有太多经验，如果有人能给我一个更好的解决方案我很感谢支持。

Answer 1

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

再次感谢您的帮助。

VBA Excel在UNC路径上使用DIR查找子文件夹 - DIR出错

1 个答案: