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

【问题标题】：VBA Excel Find child folder with DIR on UNC Path - Error with DIRVBA Excel在UNC路径上查找带有DIR的子文件夹-DIR错误
【发布时间】：2017-01-20 20:52:01
【问题描述】：

这是我第一次发帖，如有错误请见谅。

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

我正在使用循环和 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

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

【问题讨论】：

您应该检查并忽略这两个“。”并返回“..”。
你的意思是用 DIR 语句做一个 while 语句，直到返回正确的文件夹？
不，您只需要在开始搜索子文件夹之前进行If dirloop1 <> "." and dirloop1 <> ".." then 测试。与dirloop2 相同。
Dir 只能同时保持一个状态——你不能这样嵌套它。考虑改用Scripting.FileSystemObject。此外，. 是一个（虚拟）文件夹 - 它指向父目录。

标签： excel loops directory unc vba

【解决方案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

再次感谢您的帮助。

【讨论】：