[Bug 165917] PDF exports to most recent directory, not to current directory

[bugzilla-daemon]

https://bugs.documentfoundation.org/show_bug.cgi?id=165917

--- Comment #19 from BogdanB <buzea.bog...@libreoffice.org> ---
This is the macro exporting a PDF in the current folder:
Sub ExportToPDF()
    Dim oDoc As Object
    Dim sURL As String
    Dim sFilePath As String
    Dim sPDFPath As String

    oDoc = ThisComponent
    If oDoc.hasLocation Then
        ' Get the document's directory
        sURL = oDoc.getURL()
        sFilePath = ConvertFromURL(sURL)
        If sFilePath = "" Then
            MsgBox "Error: Could not determine file path.", 48, "Error"
            Exit Sub
        End If

        sFilePath = Left(sFilePath, Len(sFilePath) -
Len(GetFileName(sFilePath)))

        ' Define PDF file path
        sPDFPath = sFilePath & GetFileNameWithoutExtension(sURL) & ".pdf"

        ' Export to PDF
        Dim aProps(1) As New com.sun.star.beans.PropertyValue
        aProps(0).Name = "FilterName"
        aProps(0).Value = "writer_pdf_Export"

        oDoc.storeToURL(ConvertToURL(sPDFPath), aProps())
        MsgBox "Document exported to: " & sPDFPath, 64, "Export Successful"
    Else
        MsgBox "Please save the document before exporting.", 48, "Error"
    End If
End Sub

Function GetFileName(sFilePath As String) As String
    If sFilePath = "" Then Exit Function
    Dim sName As String
    Dim i As Integer
    i = LastIndexOf(sFilePath, "\")
    If i = 0 Then i = LastIndexOf(sFilePath, "/") ' Handle UNIX-style paths
    If i > 0 Then
        sName = Mid(sFilePath, i + 1)
    Else
        sName = sFilePath
    End If
    GetFileName = sName
End Function

Function GetFileNameWithoutExtension(sFilePath As String) As String
    Dim sName As String
    sName = GetFileName(sFilePath)
    If sName = "" Then Exit Function
    Dim i As Integer
    i = LastIndexOf(sName, ".")
    If i > 0 Then
        sName = Left(sName, i - 1)
    End If
    GetFileNameWithoutExtension = sName
End Function

Function ConvertFromURL(sURL As String) As String
    If sURL = "" Then Exit Function
    ConvertFromURL = Replace(sURL, "file://", "")
    ConvertFromURL = Replace(ConvertFromURL, "/", "\") ' Ensure Windows-style
path
End Function

Function ConvertToURL(sFilePath As String) As String
    If sFilePath = "" Then Exit Function
    ConvertToURL = "file://" & Replace(sFilePath, "\", "/") ' Ensure URL-style
path
End Function

Function LastIndexOf(text As String, character As String) As Integer
    Dim i As Integer
    For i = Len(text) To 1 Step -1
        If Mid(text, i, 1) = character Then
            LastIndexOf = i
            Exit Function
        End If
    Next i
    LastIndexOf = 0
End Function

-- 
You are receiving this mail because:
You are the assignee for the bug.