2016-09-13 2 views
0

это мой первый пост, извините за любые ошибки.VBA Excel Найти дочернюю папку с DIR на пути UNC - Ошибка с DIR

Я пытаюсь сделать петлю через папку файла сервера (UNC-путь), чтобы найти конкретную дочернюю папку (папку проекта) для сохранения рабочей книги (пользователь сообщит о проекте, связанном с этой папкой).

Я использую функцию loop и 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 

Это мой первый раз, используя программирование поэтому не имеет большого опыта работы, если есть кто-нибудь, кто мог бы дать мне лучшее решение, которое я ценю поддержку.

+0

Вы должны проверить и игнорировать оба "." и ".." возвращается. – Rory

+0

Вы хотите сделать оператор while с инструкцией DIR, пока не вернет правильную папку? – jert

+0

Нет, вам просто нужен 'If dirloop1 <>". " и dirloop1 <> ".." then "перед тем, как начать поиск в подпапках. И то же самое с 'dirloop2'. – Rory

ответ

0

Рори и Коминтерн, спасибо за поддержку, я, наконец, смог сделать это с помощью 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 

Еще раз спасибо за помощь.

Смежные вопросы