OpenOffice.info

Code: Alles auswählen

	Verz = "C:/Users/.../html"
	sPath = convertfromurl("file:///" + Verz)
	dPath = converttourl(sPath)
	sValue = Dir$(sPath & getPathSeparator() & "*", 0)

	nameSheet = "Tabelle1"
	nameCell_1 = "A11"
	
	i = 0
	n = 1

	Do
		sValue_1 = svalue
		sValue = Dir$
		myDoc = thisComponent
		mySheet_1 = myDoc.sheets(1) '2. Tabellenblatt
		
		myCell_1 = mySheet_1.getCellByPosition(1,n)
		myCell_1a = mySheet_1.getCellByPosition(0,n)
		
		myCell_1.formula = dPath & "/" & sValue_1 & "'#$" & nameSheet & "."&  nameCell_1
		myCell_1a = ConvertFromURL(myCell_1.getTextFields().getByIndex(0).URL)
		myCell_1 = ""
		
		i = i + 1
		n = n + 25
	Loop Until sValue = ""

Code: Alles auswählen

Verz = "C:/Users/Dokumente/html"
 
 xray verz
'  zeigt an: C:/Users/Dokumente/html
 
 sPath = convertfromurl("file:///" + Verz)
   
 xray spath

' zeigt an: /C:/Users/Dokumente/html

Code: Alles auswählen

      myCell_1a = ConvertFromURL(myCell_1.getTextFields().getByIndex(0).URL)
      myCell_1 = ""

Code: Alles auswählen

Function HyperAdresse ( hyp_col as Integer , irow as Integer )

'	Zellformel "=HYPERADRESSE(SPALTE(A1);ZEILE(A1))"
	
    oBlatt = ThisComponent.Sheets().getByName( "Tabelle1" )
    oZelle = oBlatt.getCellByPosition( hyp_col -1 , irow -1)
    HyperAdresse = ConvertFromURL(oZelle.getTextFields().getByIndex(0).URL)
End Function

Code: Alles auswählen

function Openhtml(sFile)
    sURL = ConvertToURL(sFile)
    Openhtml = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array())
end function

Code: Alles auswählen

Sub ExtractURLs
	On Error GoTo ErrorMessage
	sVerzeichnis = "C:/Users/.../html" 'Verzeichnis der HTML-Dateien
	nSpalteInHTML = 0 'In welcher Spalte der HTML-Datei stehen die Links?
	nStartZeileInHTML = 10 'Ab welcher Zeile in der HTML-Datei nach Links suchen?
	nEndZeileInHTML = 34 'Bis zu welcher Zeile?
	sZielTabelle = "Tabelle1" 'In welcher Tabelle sollen die Links gesammelt werden?
	bLinksAlsHyperlink = False 'Sollen die die gesammelten Links als Hyperlinks erstellt werden?
	
	oDoc = thisComponent
	oDoc.lockControllers
	
	If NOT oDoc.Sheets.hasByName(sZielTabelle) Then
		MsgBox "Tabelle """ & sZielTabelle & """ nicht gefunden",16,"Fehler"
		GoTo ErrorMessage
	End If
	oSheet = oDoc.Sheets.getByName(sZielTabelle)
	
	If NOT oDoc.Sheets.hasByName("DummyTabelle") Then
		oDoc.Sheets.insertNewByName("DummyTabelle",oDoc.Sheets.Count)
	End If
	oDummySheet = oDoc.Sheets.getByName("DummyTabelle")
	oDummySheet.LinkMode = 1
		
	Dim aArray(0)
	Dim aLine(0)
	nCurrentRow = -1
	
	If Right(sVerzeichnis,1) <> getPathSeparator Then
		sVerzeichnis = sVerzeichnis & getPathSeparator
	End If
	sFileName = Dir(ConvertToURL(sVerzeichnis),0)
	Do While sFileName <> ""
		sURL = ConvertToURL(sVerzeichnis & sFileName)
		oDummySheet.LinkURL = sURL
		For i = nStartZeileInHTML To nEndZeileInHTML
			oTargetCell = oDummySheet.getCellByPosition(nSpalteInHTML,i)
			oCellTextFields = oTargetCell.TextFields
			For m = 0 To oCellTextFields.Count - 1
				nCurrentRow = nCurrentRow + 1
				ReDim Preserve aArray(nCurrentRow)
				ReDim aLine(0)
				If bLinksAlsHyperlink Then
					aLine(0) = "=HYPERLINK(""" & oCellTextFields(m).URL & """)"
				Else
					aLine(0) = oCellTextFields(m).URL
				End If
				aArray(nCurrentRow) = aLine
			Next m
		Next i
		sFileName = Dir
	Loop
	If nCurrentRow > -1 Then
		oRange = oSheet.getCellRangeByPosition(0,0,0,nCurrentRow)
		oRange.setFormulaArray(aArray)
	End If
	oDoc.Sheets.removeByName("DummyTabelle")
	Do While oDoc.hasControllersLocked
		oDoc.unlockControllers
	Loop
	MsgBox "Operation abgeschlossen",64,"URL-Extraktion"
	Exit Sub
	ErrorMessage:
	MsgBox "Es ist ein Fehler aufgetreten",16,"URL-Extraktion"
	If oDoc.Sheets.hasByName("DummyTabelle") Then
		oDoc.Sheets.removeByName("DummyTabelle")
	End If
	Do While oDoc.hasControllersLocked
		oDoc.unlockControllers
	Loop
End Sub