Calc: URL per Makro aus html-Datei auslesen

[sokitrop]

Hallo zusammen.

Seit Stunden verbiege ich mir mein Hirn komme aber einfach nicht mehr weiter. Daher ersuche ich jetzt hier um Hilfe.

Ich habe ca. 90 html-Seiten, die in Tabellenform angelegt sind. Sie befinden sich in einem Ordner "html". Auf jeder dieser Seiten befinden sich jeweils 25 Hyperlinks. Die URL's dieser Links will ich mittels Makro in eine Calc-Tabelle übertragen.

Wenn ich die html-Seiten in Calc öffne, finde ich die Links immer in "Tabelle1" und immer in den selben Zellen (A11:A35). Ich habe kein Problem, den Zellinhalt per Makro (fand ich irgendwo hier im Forum, weiß aber leider nicht mehr wo) aus den html-Seiten in eine Calc-Tabelle zu übertragen. Allerdings erhalte ich dann immer nur die Linkbezeichnung und nicht die URL selbst, also z.B. "OOo Basic und Java" anstatt "viewforum.php?f=18".

Von Hand rüberkopieren und die URL's innerhalb meiner Calc-Tabelle auszulesen habe ich dank der hilfreichen Beiträge in diesem Thread an sich auch kein Problem, bei 90 Seiten ist copy&paste allerdings "etwas" mühselig.

Jetzt versuche ich aus beidem ein neues Makro zusammenzubasteln. Das Ergebnis bisher:

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 = ""

In der Zeile mit "ConvertFromURL" kommt immer die Exception "IndexOutOfBounds". Ab hier komm ich einfach nicht weiter. Ich habe das Forum nach vielen möglichen Schlagworten durchsucht, konnte bisher aber nichts finden was mein Problem löst. So hoffe ich jetzt auf eure Hilfe.

Vielen Dank schon mal vorab!
sokitrop

[komma4]

Willkommen im Forum


Bau' Dir einfach ein PRINT Anweisung ein, dann siehst Du mehr

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

Index-Fehler kommt hier keiner.

Ansonsten:

* was passiert, wenn Du die in CALC geöffnete HTML als *.ods speicherst? Dann solltest Du die Hyperlinks kopieren können...

* warum setzt Du die Formel nicht auf (bspw.): =HYPERLINK("C:/Users/Dokumente/html/Dok1.ods")

[DPunch]

Aloha

In der Zeile mit "ConvertFromURL" kommt immer die Exception "IndexOutOfBounds".

Einfache Erklärung:
In dieser Zelle gibt es kein Textfeld. Soweit ich dem Code folgen kann, schreibst Du lediglich eine Formel in die Zelle.

Zudem sollte das Verwenden von

Code: Alles auswählen

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

kaum funktionieren.
Wenn überhaupt würde es wohl "myCell_1a.String = x" heissen.

[sokitrop]

Danke euch beiden für die wirklich rasche Antwort.

Ich entschuldige mich gleich mal für vielleicht "dumme" Fragen. Allerdings bin ich in Bezug auf Basic/Makros irgendwann während der DOS-Zeiten ausgestiegen. Nachdem ich mir OO installiert hab versuche ich so nach und nach durchzusteigen, Immer halt dann, wenn ich auf "konventionelle" Weise nicht mehr weiterkomme. Das meiste dann wirklich nach dem "search-find-try-error"-Prinzip. Deshalb bitte ich um Nachsicht.

@DPunch:
"myCell_1a.String = x" macht Sinn. Trotzdem erhalte ich diese "IndexOutOfBounds"-Exception. Ich vermute, es liegt an dem "getByIndex(0)", aber ich verstehe halt auch nicht, was "getTextFields()"und "getByIndex(0)" überhaupt bewirken. Ich finde einfach darüber nichts. In der Function

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

funktionierts, leider nur im selben Sheet.

@Winfried:
Guter Tip, die html-Dateien erstmal in Calc zu öffnen und dort als .ods abzuspeichern. Ich habs bisher blöderweise mit Umbenennen der Endung versucht.

HYPERLINK("C:/...) bringt mir nichts. Als Ausgabe kommt ja "OOo Basic und Java" und nicht "viewforum.php?f=18". Es sei denn, es gibt noch einen Parameter, mit dem man das einstellen kann?

Ich werd mal versuchen, ob ich das Öffnen der html-Dateien mit Calc irgendwie automatisieren kann. Bisher geht bei mir mit

Code: Alles auswählen

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

immer nur der Writer auf. Aber da werd ich schon einen Weg finden, hoffe ich mal.
Wenn ich das hinbekomme, kann ich auch per Makro "=HYPERADRESSE(SPALTE(Ax);ZEILE(Ax))" (s.o.) in ein freie Zelle schreiben und die Datei als .ods abspeichern lassen. Danach sollte dann das Kopieren per Makro kein Problem mehr sein. Ist zwar nicht so elegant, wie ich mir das vorgestellt habe, aber jetzt versuch ichs einfach mal so.

Danke nochmal fürs erste,
Sokitrop

[DPunch]

Aloha

Ich vermute, es liegt an dem "getByIndex(0)", aber ich verstehe halt auch nicht, was "getTextFields()"und "getByIndex(0)" überhaupt bewirken.

Es wird versucht, das TextField mit dem Index 0 anzusprechen - gibt es in der Zelle kein TextField, dann kann es auch keins bei Index 0 geben, daher die Fehlermeldung.

In der Function (...) funktionierts, leider nur im selben Sheet.

Das funktioniert *nur* wenn Du auf eine Zelle mit TextFields referenzierst. Ein über Einfügen -> Hyperlink erstellter Link wird z.B. in einem TextField gehalten.
In Deinem Code schreibst Du eine Formel in die entsprechende Zelle, aber erstellst kein TextField.

Wenn Dein Ziel ist, alle Links aus den HTML-Dateien in einer Tabelle zu sammeln, dann probier es mal mit diesem Code:

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

[sokitrop]

Allerbesten Dank, DPunch!

Was "getTextFields()"und "getByIndex(0)" angeht, kann ich jetzt nachvollziehen, warum es in meinem Code nicht funktioniert hat.

Und:
Genau das ist mein Ziel. Dein Code funktioniert perfekt!!!

Nochmals vielen herzlichen Dank! - Problem gelöst.