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

Имя Файла по полному Пути или определённую чать (только название или только расширение).

Public Function GetFileNameByPath(varPath As Variant) As String
'Аргумент: varPach = Полный путь к файлу
'Возвращает имя файла (по указанному в аргументе) полному пути.
'--------------------------------------------------------------------
On Error GoTo GetFileNameByPath_Err
    GetFileNameByPath = Mid(varPath, InStrRev(varPath, "\") + 1)
    Exit Function

GetFileNameByPath_Err:
    GetFileNameByPath = "GetFileNameByPath ERR#" & Err.Number
End Function



Более сложный вариант:
Может возвращаать не только имя файла, но и его определённую чать (только название или только расширение).

Public Function GetFileName(ByVal sPath As String, Optional NamePart As Integer = 0) As String
'Функция возвращает имя файла по полному пути к файлу (по умолчанию - NamePart = 0)
'Или часть имени файла:
'   NamePart = 1   Только имя (без расширения) 
'   NamePart = 2   Только расширение
'--------------------------------------------------------------------
Dim sFileName As String
Dim iPos As Integer

On Error GoTo GetFileName_Err

'Ищем позицию первого символа "\" (справа-налево)
    iPos = InStrRev(sPath, "\")
    sFileName = Mid(sPath, iPos + 1)
    Select Case NamePart
            Case 1
            'Ищем позицию первого символа "." (справа-налево)
            iPos = InStrRev(sFileName, ".")
            sFileName = Mid(sFileName, 1, iPos - 1) 'Вырезаем имя файла из строки
        Case 2
            'Ищем позицию первого символа "." (справа-налево)
            iPos = InStrRev(sFileName, ".")
            sFileName = Mid(sFileName, iPos + 1) ' Вырезаем расширение файла из строки
    End Select
   
    GetFileName = sFileName

GetFileName_Bye:
    Exit Function

GetFileName_Err:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure GetFileName of Module modUtils", vbCritical, "Error!"
    Resume GetFileName_Bye
End Function


Самый быстрый вариант

Public Function OnlyName(path)
Dim File As String, Ext As String
    With Access.WizHook
        .Key = 51488399
        .SplitPath path, vbNullString, vbNullString, File, Ext
    End With
OnlyName = File & Ext
End Function


Имя существующего файла по полному пути

Public Function FileNameByPath(sPath As String) As String
'es 09.05.2019
'Возвращает имя существующего файла по полному пути
'--------------------------------------------------------------------------
Dim objFSO As Object
Dim objFile As Object
'Dim lFileSize&
'--------------------------------------------------------------------------
'?FileNameByPath("d:\Temp\19.pdf")
On Error GoTo FileNameByPath_Err
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(sPath)
    'lFileSize = CLng(objFile.Size) 'Размер в байтах
    FileNameByPath = objFile.Name

FileNameByPath_End:
    On Error Resume Next
    Err.Clear
    Exit Function

FileNameByPath_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Function: FileNameByPath in module: 00_Tests", vbCritical, "Error in Application"
    Err.Clear
    Resume FileNameByPath_End
End Function
Назад ToTop
L.E. 25.10.2024
Рейтинг@Mail.ru