Space1000

Sub Main

    Dim Str As String
    Dim Parsed As Object
    
    Str = GetDocFullPath() ' "/home/user/document.ods"                         '
    Parsed = ParseFilePath(Str)
    
    MsgBox("FileDir:" + Parsed.FileDir) ' "/home/user/"                        '
    MsgBox("FileName:" + Parsed.FileName) ' "document.ods"                     '
    MsgBox("FileDirName:" + Parsed.FileDirName) ' "user"                       '
    MsgBox("FileFullPath:" + Parsed.FileFullPath) ' "/home/user/document.ods"  '
    MsgBox("FileExtension:" + Parsed.FileExtension) ' "ods"                    '
    MsgBox("FileDirNoSlash:" + Parsed.FileDirNoSlash) ' "/home/user"           '
    MsgBox("FileNameNoExtension:" + Parsed.FileNameNoExtension) ' "document"   '
    
End Sub

Type FilePathParsedByParseFilePathFunction
	
    FileDir As String
    FileName As String
    FileDirName As String
    FileFullPath As String
    FileExtension As String
    FileDirNoSlash As String
    FileNameNoExtension As String
	
End Type

Function ParseFilePath(ByVal FullPath As String) As Object
    
    Dim i As Long
    Dim PathLen As Long
    Dim PathURL As String
    Dim DirLenDiff As Long
    Dim BaseNameLen As Long
    Dim BaseDirectory As String
    Dim BaseNameExtDiff 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)
    ParseFilePath = CreateObject("FilePathParsedByParseFilePathFunction")
    ParseFilePath.FileFullPath = 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
            ParseFilePath.FileName = 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(ParseFilePath.FileName)
    BaseNameLastDotIndex = BaseNameLen
    For i = BaseNameLen To 2 Step -1
        If Mid(ParseFilePath.FileName,i,1) = "." Then
            BaseNameLastDotIndex = i
            Exit For
        End If
    Next i
    ParseFilePath.FileExtension = Right(ParseFilePath.FileName,BaseNameLen - BaseNameLastDotIndex)
    BaseNameExtDiff = BaseNameLen - Len(ParseFilePath.FileExtension) - 1
    If BaseNameExtDiff < 0 Then
        BaseNameExtDiff = 0
    End If
    ParseFilePath.FileNameNoExtension = Left(ParseFilePath.FileName,BaseNameExtDiff)
    ' Getting directory name with slash and without.                           '
    DirLenDiff = Len(FullPath) - Len(ParseFilePath.FileName)
    ParseFilePath.FileDir = Left(FullPath,DirLenDiff)
    DirLenDiff = DirLenDiff - 1
    If DirLenDiff < 0 Then
        DirLenDiff = 0
    End If
    ParseFilePath.FileDirNoSlash = Left(FullPath,DirLenDiff)
    ' Getting file directory name.                                             '
    PathURL = ConvertToURL(ParseFilePath.FileDirNoSlash)
    If Left(PathURL,7) <> "file://" Then 
        PathURL = ConvertToURL("/" + ParseFilePath.FileDirNoSlash)
    End If
    PathLen = Len(PathURL)
    For i = PathLen To 1 Step -1
        If Mid(PathURL,i,1) = "/" Then
            ParseFilePath.FileDirName = ConvertFromURL(Right(PathURL,PathLen - i))
            Exit For
        End If
    Next i
    
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

Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса можно использовать чтобы парсить полный путь к файлу, получая из него все необходимые части: имя файла, расширение, имя директории, путь без имени файла, имя файла без расширения и т.п.

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

Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса возвращает строку, содержащую расширение файла, или пустую строку, если у файла нет расширения. Данная функция полезна в случае когда нужно узнать расширение по имени файла, либо по полному пути к файлу.

Libreoffice has built-in function to explode strings called Split. To join array into string there is an opposite "implode" function Join.

Sub Main

	Dim str As String	
	Dim arr() As String

	str = "Calc||Microsoft Excel 97/2000/XP|xls|MS Excel 97"
	arr = Split(str,"|")
	MsgBox(arr(0))        ' "Calc"                                                '
	MsgBox(arr(4))        ' "MS Excel 97"                                         '
	MsgBox(Join(arr,",")) ' "Calc,,Microsoft Excel 97/2000/XP,xls,MS Excel 97"    '
	
End Sub

Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса для разделения строк использует аналоги PHP-функций explode и implode, называемые Split и Join. Split разделяет строку при помощи разделителя в массив, а Join собирает массив в строку, объединяя указанным разделителем.

Ошибка может произойти и поставить в тупик в том случае, если определение функции расположено ранее её первого вызова и при этом вызов осуществлен без обязательных аргументов. Например:

Sub Main

	Dim str As String	
	str = GetDocFullPath()
	MsgBox(GetFileBaseName(str))
	
End Sub

Function GetDocFullPath(sInput as String) As String

	GetDocFullPath = ConvertFromURL(ThisComponent.getLocation())
	
End Function

Код выше сгенерирует ошибку

BASIC syntax error.
Symbol GetDocFullPath already defined differently.

Если же переместить местами определение функции, то ошибки уже не появится

Function GetDocFullPath(sInput as String) As String

	GetDocFullPath = ConvertFromURL(ThisComponent.getLocation())
	
End Function

Sub Main

	Dim str As String	
	str = GetDocFullPath()
	MsgBox(GetFileBaseName(str))
	
End Sub

Но можно и нужно в первую очередь исправить сам некорректный вызов функции, тогда и проблемы не будет.

Sub Main

	Dim str As String	
	str = GetDocFullPath("BLABLABLA")
	MsgBox(GetFileBaseName(str))
	
End Sub

Function GetDocFullPath(sInput as String) As String

	GetDocFullPath = ConvertFromURL(ThisComponent.getLocation())
	
End Function

Sub Main
    
    Dim str As String   
    
    str = GetDocFullPath()       ' "/home/user/document.ods"                   '
    MsgBox(GetFileBaseName(str)) ' "document.ods"                              '
    
    str = "C:\Windows\system32\drivers\etc\hosts"
    MsgBox(GetFileBaseName(str)) ' "hosts"                                     '
    
    str = "test.ods"
    MsgBox(GetFileBaseName(str)) ' "test.ods"                                  '
    
    str = "many.dots.in.file.name.ods"
    MsgBox(GetFileBaseName(str)) ' "many.dots.in.file.name.ods"                '
    
End Sub

' Returns the filename of the given path.                                      '
' For example "/home/user/document.ods" input will return "document.ods".      '
' ByVal keyword prevents FullPath from modification because by default         '
' arguments are passed by reference.                                           '
Function GetFileBaseName(ByVal FullPath As String) As String

    Dim i As Long
    Dim PathLen As Long
    Dim PathURL As String
    ' 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
            GetFileBaseName = ConvertFromURL(Right(PathURL,PathLen - i))
            Exit For
        End If
    Next i

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

Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса можно использовать чтобы получить имя файла и его расширение из полного пути к файлу.

Longstory:

Sub Main
	
	Sheet = ThisComponent.CurrentController.getActiveSheet()
	Cell = Sheet.getCellRangeByName("A1")
	Cell.setString("Hello World")
	MsgBox("Check the A1 cell contents! It will not be saved!")
	
	CloseDocIgnoreConfirmation()
	
End Sub

Function CloseDocIgnoreConfirmation()

	ThisComponent.Close(TRUE)

End Function

Short:

ThisComponent.Close(TRUE)

Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса можно использовать чтобы закрыть текущий документ, не спрашивая пользователя сохранить его или нет. Таким образом можно программно закрыть несохраненный документ, не сохранив изменения в нём и игнорируя диалоговые окна, мешающие закрытию.

Sub Main
    
    MsgBox(GetDocFullPath())
    
End Sub

' 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

Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса можно использовать чтобы получить полный путь к текущему (над которым работает макрос) документу / файлу в обычном формате.