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

Проверка на существование папки (сетевой) по пути (FSO + Dir)

Public Function IsFolderExist(sFolderPath$) As Boolean
' es - 27.04.2024 v04 LE: 14.10.2024
' Проверка на существование (сетевой) папки и если есть - вернёт True
' ?IsFolderExist("c:\Windows")
'---------------------------------------------------------------------------------------------------/
Dim objFSO As Object
On Error GoTo IsFolderExist_Err
    
    If Len(sFolderPath) < 3 Then GoTo IsFolderExist_End
    
    If Not Mid(sFolderPath, 2, 2) = ":\" Then
         If Not Left(sFolderPath, 2) = "\\" Then GoTo IsFolderExist_End
    End If
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    IsFolderExist = objFSO.FolderExists(sFolderPath)
 
IsFolderExist_End:
    Set objFSO = Nothing
    Exit Function
 
IsFolderExist_Err:
    'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function" & _
           "IsFolderExist.", vbCritical, "Error in module  [Название вашего модуля]"
    Err.Clear
    Resume IsFolderExist_End
End Function



Вариант с Dir() - по скоости работы не уступает FSO

Public Function IsFolderExist(sFlderPath$, Optional bolSilentMode As Boolean) As Boolean
' es 27.12.2021 - v002
' Проверка на сушествование (сетевой) папки - если есть - вернёт True
'--------------------------------------------------------------------------------------------------------
Dim sVal As String, sErrPlus$, iErrType
On Error GoTo IsFolderExist_Err

    sVal = Dir(sFlderPath, vbDirectory) ' Запуск функции 'Dir'.
    If sVal = "" Then
        If bolSilentMode = False Then
            sVal = "Путь:" & vbCrLf & sFlderPath & vbCrLf & _
                    "- не существует."
            MsgBox sVal, vbExclamation
        End If
        GoTo IsFolderExist_Bye
    End If
    
    IsFolderExist = True 'OK!
    
IsFolderExist_Bye:
   Exit Function

IsFolderExist_Err:
    Select Case Err.Number
        Case 52
            sVal = "Путь:" & vbCrLf & sFlderPath & vbCrLf & _
                "- не доступен." & vbCrLf & _
                "Возможно удалённый компьютер выключен."
            iErrType = vbExclamation
            sErrPlus = "Проверьте доступность пути!"
        
        Case Else
            sVal = "Ошибка " & Err.Number & vbCrLf & _
                Err.Description & vbCrLf & "в функции: IsFolderExist"
            iErrType = vbCritical
            sErrPlus = "Error in module [modFilesAndFolders]"
    End Select
    If bolSilentMode = False Then
        MsgBox sVal, vbCritical, sErrPlus
    End If
    Err.Clear
    Resume IsFolderExist_Bye
End Function

Назад ToTop
L.E. 27.10.2024
Рейтинг@Mail.ru