Sub Main
Dim str As String
str = GetDocFullPath()
MsgBox(str + " -> " + GetFileExtension(str))
' "/home/user/document.ods -> ods" '
str = "C:\Windows\system32\drivers\etc\hosts"
MsgBox(str + " -> " + GetFileExtension(str))
' "C:\Windows\system32\drivers\etc\hosts -> " '
str = "C:\Windows\system32\drivers\etc\hosts.ods.zip"
MsgBox(str + " -> " + GetFileExtension(str))
' "C:\Windows\system32\drivers\etc\hosts.ods.zip -> zip" '
str = "many.dots.in.file.name.ods"
MsgBox(str + " -> " + GetFileExtension(str))
' "many.dots.in.file.name.ods -> ods" '
str = "test.ods"
MsgBox(str + " -> " + GetFileExtension(str))
' "test.ods -> ods" '
str = ".htaccess"
MsgBox(str + " -> " + GetFileExtension(str))
' ".htaccess -> " '
str = ""
MsgBox(str + " -> " + GetFileExtension(str))
' " -> " '
End Sub
' Returns extension by filename. '
' Notice that files starting with dot (.htaccess) have no extension. '
Function GetFileExtension(ByVal FullPath As String) As String
Dim i As Long
Dim PathLen As Long
Dim PathURL As String
Dim BaseName As String
Dim BaseNameLen As Long
Dim BaseNameLastDotIndex As Long
' Fetching file base name from FullPath '
' Converting to URL for Linux/Windows compatibility. '
' URL notation does not allow certain special characters to be used. '
' These are either replaced by other characters or encoded. A slash '
' (/) is used as a path separator. For example, a file referred to as '
' C:\My File.sxw on the local host in "Windows notation" becomes '
' file:///C|/My%20File.sxw in URL notation. '
' https://help.libreoffice.org/Basic/Basic_Glossary '
PathURL = ConvertToURL(FullPath)
' FullPath could be mistakenly converted to http. For example: '
' ConvertToURL("many.dots.in.file.name.ods") will be misinterpreted. '
If Left(PathURL,7) <> "file://" Then
PathURL = ConvertToURL("/" + FullPath)
End If
PathLen = Len(PathURL)
For i = PathLen To 1 Step -1
If Mid(PathURL,i,1) = "/" Then
BaseName = ConvertFromURL(Right(PathURL,PathLen - i))
Exit For
End If
Next i
' Finding last occurence of "." in the file name. First symbol is ignored '
' due to filenames starting with dot (.htaccess) have no extension. '
BaseNameLen = Len(BaseName)
BaseNameLastDotIndex = BaseNameLen
For i = BaseNameLen To 2 Step -1
If Mid(BaseName,i,1) = "." Then
BaseNameLastDotIndex = i
Exit For
End If
Next i
GetFileExtension = Right(BaseName,BaseNameLen - BaseNameLastDotIndex)
End Function
' Returns document full path if document has a path. Returns empty string if '
' document has no path and IgnoreNoPathError flag is set to TRUE. '
Function GetDocFullPath(Optional IgnoreNoPathError as Boolean) As String
' Default behavior is to return empty string if document location is empty.'
' This can happen if document is new and not saved thus do not have a path.'
If NOT ThisComponent.hasLocation() AND IgnoreNoPathError <> TRUE Then
' Err.Raise is not valid statement but will generate error anyway. '
Err.Raise("Document has no path. Probably because is not saved.")
End If
GetDocFullPath = ConvertFromURL(ThisComponent.getLocation())
End Function
Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса возвращает строку, содержащую расширение файла, или пустую строку, если у файла нет расширения. Данная функция полезна в случае когда нужно узнать расширение по имени файла, либо по полному пути к файлу.