VBA, MS Access MS Access в примерах

Проверка на наличие и создание папок произвольной вложенности (FSO)

По материалам: https://www.cyberforum.ru/vba/thread2879906-page2.html

Function ChkFolder(NewPath) As Boolean
'Рекурсивно проверяет путь и досоздаёт папку. Возвращает True - если удачно.
'----------------------------------------------------------------------------------------
Dim PrePath, FSO As Object
On Error GoTo ChkFolder_Err
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    ChkFolder = True
    If FSO.FolderExists(NewPath) Then Exit Function
    
    PrePath = FSO.GetParentFolderName(NewPath)
    If ChkFolder(PrePath) Then FSO.CreateFolder NewPath
    ChkFolder = FSO.FolderExists(NewPath)
      
ChkFolder_End:
    On Error Resume Next
    Set FSO = Nothing
    Err.Clear
    Exit Function

ChkFolder_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function" & _
           "ChkFolder - 00_Tests.", vbCritical, "Произошла ошибка!"
    'Debug.Print "ChkFolder_Line: " & Erl & "."
    Err.Clear
    Resume ChkFolder_End
End Function
Назад ToTop
L.E. 08.10.2021
Рейтинг@Mail.ru