Use Writer BASIC to convert text to hyperlink in current odt document

[andrew7070]

([[Reference-files/ItemA.pdf|Item Name]])

The above text is a target text for search and matches the format ([[Note link path|Display Text]]). I need to run Writer code, so it converts the target text string, so only the Display Text shows, while clicking it leads to activation of the underlying path ‘Note link path’ in the case above ‘/Reference-files/ItemA.pdf’. I deployed the code below. When run, the section: ’ oText.insertTextContent(oFound, oHyperlink, False)’ raises error:

BASIC funtime error.
An exception occurred
Type: com.sun.star.lang.IllegalArgumentException
Message:./editeng/source/uno/unofield.cxx:660.

Basic debugging result suggest oFound.String does return the expected text.

This is essentially is my first attempt at running Writer BASIC and I am totally lost. I hope the issue is resolvable. The entire code is found below:

The code is:

Sub EditObsidianOdt
    Dim oDoc As Object
    Dim oText As Object
    Dim oCursor As Object
    Dim oVC As Object
    Dim oHyperlink As Object
    Dim sURL As String
    Dim sDisplayText As String
    Dim sFileName As String
    Dim sDocPath As String
    Dim sDewPath As String
    Dim fullPath As String
    Dim separator As String
    Dim pos As Integer

    ' Get the current document and its text
    oDoc = ThisComponent
    oText = oDoc.Text

    ' Create a new text cursor from the document
    oCursor = oText.createTextCursor()

    ' Get the full path of the current document
    fullPath = ConvertFromURL(oDoc.URL)
    ' sDocPath = ConvertFromURL(oDoc.URL)
    
    ' Find the position of the last path separator
    separator = GetPathSeparator()
    'msgbox(fullPath)
    pos = LastIndexOf(fullPath, separator)
    'pos = InStrRev(fullPath, separator)
    
    ' Get the path of the directory containing the current document
    sDocPath = Left(fullPath, pos - 1)
    'msgbox(sDocPath)
    sDewPath = sDocPath & separator & "Reference-files"
    'sDewPath = sDocPath & "/Reference-files/"

    ' Search the document for text enclosed in [[ and ]]
    oVC = oDoc.CurrentController.getViewCursor()
    oSearchDesc = oDoc.createSearchDescriptor()
    oSearchDesc.SearchString = "(?s)\[\[.*\]\]"
    ' oSearchDesc.SearchString = "\[\[.*\]\]"
    oSearchDesc.SearchRegularExpression = True

    Do
        oFound = oDoc.findFirst(oSearchDesc)
        If Not IsNull(oFound.String) Then
        ' Print the string value of oFound
         ' Print "oFound is " & oFound.String
         'stop
        ' ...
        else
        Print "oFound is Nothing"
	    End If
        
        'If (Not oFound Is Nothing) Then
        'msgbox(oFound)
	        'Debug.Print "oFound is " & oFound
		'end if
        If Not IsNull(oFound) Then
            ' Check if | is present in the found text
            If InStr(oFound.String, "|") > 0 Then
                ' Split the found text on |
                sDisplayText = Split(oFound.String, "|")(1)
                sFileName = Split(oFound.String, "|")(0)
            Else
                sDisplayText = oFound.String
                sFileName = oFound.String
                
            End If

            ' Remove [[ and ]] from sFileName
            sFileName = Replace(sFileName, "[[", "")
            sDisplayText = Replace(sDisplayText, "]]", "")
            'Print "sDisplayText is " & sDisplayText
			'Print "sFileName is " & sFileName
			
            ' Create the hyperlink
            sURL = sDewPath & separator & sFileName
            'msgbox(sURL)
            oHyperlink = oDoc.createInstance("com.sun.star.text.TextField.URL")
            oHyperlink.URL = sURL
            oHyperlink.Representation = sDisplayText
            
		' Check if oFound is a valid TextRange and oHyperlink is a valid TextField
    	' Check if oFound is a valid TextRange and oHyperlink is a valid TextField
		'If Not oFound.supportsService("com.sun.star.text.TextRange") Then
    	'	Print "oFound does not support the service com.sun.star.text.TextRange"
		'End If
		'If Not oHyperlink.supportsService("com.sun.star.text.TextField") Then
    	'	Print "oHyperlink does not support the service com.sun.star.text.TextField"
		'End If
		'If oHyperlink.supportsService("com.sun.star.text.TextField") Then
		'If oFound.supportsService("com.sun.star.text.TextRange") And oHyperlink.supportsService("com.sun.star.text.TextField") Then
		    ' Replace the found text with the hyperlink
		    oText.insertTextContent(oFound, oHyperlink, False)
		
		    ' Italicize and underline the hyperlink text
		    oHyperlink.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
		    oHyperlink.CharPosture = com.sun.star.awt.FontSlant.ITALIC
		
		    ' Move the view cursor to the end of the hyperlink
		    oVC.gotoRange(oFound, False)
		    oVC.goRight(len(oHyperlink.Representation), False)
		'Else
		    Print "Invalid TextRange or TextField"
		'End If
     End If
    Loop Until IsNull(oFound)
End Sub


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

[KamilLanda]

com.sun.star.TextField.URL is for Calc or Draw. Writer uses different definition for hyperlinks.

Sub insertHyperlinkToDoc()
	dim oDoc as object, oText as object, sUrl1$, sUrl2$, oPos1 as object, oPos2 as object
	sUrl1="https://ask.libreoffice.org/en/questions/"
	sUrl2="https://libreoffice.org/"
	oDoc=ThisComponent
	oText=oDoc.Text
	oText.String=" Wow " 'insert some text
	
	oPos1=oText.Start 'start of inserted text
	with oPos1 'hyperlink1
		.String=sUrl1
		.HyperlinkURL=sUrl1
		.CharStyleName="Internet link"
	end with
	
	oPos2=oText.End 'end of inserted text
	with oPos2 'hyperlink2
		.String=sUrl2
		.HyperlinkURL=sUrl2
		.CharStyleName="Internet link"
	end with
End Sub

[andrew7070]

Thanks for your submission. Your point that Writer used a different definition was most helpful. I now have working code that I can continue to finess. For some reason, CTRL + left click does not work but exporting to pdf has the click working. That’s good enough at this point. Am most grateful.

Sub EditObsidianOdt
    Dim oDoc As Object
    Dim oText As Object
    Dim oCursor As Object
    Dim oVC As Object
    Dim oHyperlink As Object
    Dim sURL As String
    Dim sDisplayText As String
    Dim sFileName As String
    Dim sDocPath As String
    Dim sDewPath As String
    Dim fullPath As String
    Dim separator As String
    Dim pos As Integer
    ' Get the current document and its text
    oDoc = ThisComponent
    oText = oDoc.Text
    ' Create a new text cursor from the document
    oCursor = oText.createTextCursor()
    ' Get the full path of the current document
    fullPath = ConvertFromURL(oDoc.URL)
    ' Find the position of the last path separator
    separator = GetPathSeparator()
    pos = LastIndexOf(fullPath, separator)
    ' Get the path of the directory containing the current document
    sDocPath = Left(fullPath, pos - 1)
    sDewPath = sDocPath & separator & "Reference-files"
    ' Search the document for text enclosed in [[ and ]]
    oVC = oDoc.CurrentController.getViewCursor()
    oSearchDesc = oDoc.createSearchDescriptor()
    oSearchDesc.SearchString = "(?s)\[\[.*\]\]"
    oSearchDesc.SearchRegularExpression = True

    Do
        oFound = oDoc.findFirst(oSearchDesc)
        If Not IsNull(oFound) Then
            ' Check if | is present in the found text
            If InStr(oFound.String, "|") > 0 Then
                ' Split the found text on |
                sDisplayText = Split(oFound.String, "|")(1)
                sFileName = Split(oFound.String, "|")(0)
            Else
                sDisplayText = oFound.String
                sFileName = oFound.String
            End If

            ' Remove [[ and ]] from sFileName and sDisplayText
            sFileName = Replace(sFileName, "[[", "")
            sFileName = Replace(sFileName, "]]", "")
            sDisplayText = Replace(sDisplayText, "[[", "")
            sDisplayText = Replace(sDisplayText, "]]", "")
            oFound.String = sDisplayText
            oFound.HyperlinkURL = "." & separator & sFileName
            ' oText.insertTextContent(oFound, oHyperlink, False)
        End If
    Loop Until IsNull(oFound)
End Sub