TopPicLogo TopPicText

Папка по полному пути к файлу

Public Function FolderByPath(varPath As Variant, Optional bolRetWithSlash As Boolean = False) As String
'es 10.07.2012 : le 07.10.2016
'Возвращает путь к папке по указанному в аргументе полному пути к файлу.
'--------------------------------------------------------------------
'   По умолчанию Возвращаемая строка не содержит слеша в конце "C:\Temp"
'   При ошибке возвращает корень диска "C:\"
'--------------------------------------------------------------------

On Error GoTo FolderByPath_Err
    'Рубим путь до последнего левого слеша ("\")
    FolderByPath = Mid(varPath, 1, InStrRev(varPath, "\") - 1)

'На всякий случай - проверка существования пути (не обязательно)
    If Dir(FolderByPath, vbDirectory) = "" Then FolderByPath = "C:"

FolderByPath_Bye:
    If bolRetWithSlash = True Then FolderByPath = FolderByPath & "\"
    Exit Function

FolderByPath_Err:
    FolderByPath = "C:"
    
    Resume FolderByPath_Bye
End Function

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