[VBA] - Bestimmte Zeile aus HTML Dokument auslesen?
Hallo Community,
ich habe folgendes Problem.
Ich habe eine Excel Tabelle mit vielen ID's (Spalte B) und einen Ordner mit HTML-Dateien, die den IDs zugeordnet sind.
Im ersten Schritt bin ich alle ID's durchgegangen und habe falls vorhanden, die passende HTML Datei in einen Ordner abgespeichert.
Nun kommt der zweite Schritt bei dem ich eure Hilfe brauche. Ich möchte alle gefunden HTML Dateien durchgehen und nach einem bestimmten Bereich suchen. Im HTML Code sieht das ungefähr so aus:
<td class="category">
<a name="attachments" id="attachments">Angehängte Dateien</a> </td>
<td colspan="5">
<a> unwichtig </a>
<a> WICHTIG </a> <- Hier steht der gesuchte Dateiname
<a> Unwichtig </a>
</td>
Das Ding ist, dass in diesem <td> Tag auch mehrere Dateien aufgeführt sind, der Aufbau ist aber immer gleich. Pro Datei gibt es 3 mal ein <a>-Tag und im mittleren stehen die wichtigen Informationen. Es gibt auch den Fall, dass dort keine Dateien und somit auch keine <a>-Tags vorhanden sind.
Mein bisheriges Makro sieht wie folgt aus:
Const path = "M:*"
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Worksheets(2)
maxRow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
Dim id As String
Dim sourcePath As String
Dim destPath As String
Dim Filename As String
For Row = 2 To maxRow
sourcePath = path & "view.php-id=" & sheet.Cells(Row, 2) & ".html"
Filename = "view.php-id=" & sheet.Cells(Row, 2) & ".html"
MkDir (path & "gefunden\" & sheet.Cells(Row, 2))
destPath = path & "gefunden\" & sheet.Cells(Row, 2) & "\" & sheet.Cells(Row, 2) & ".html"
If Dir(sourcePath) = Filename Then
FileCopy sourcePath, destPath
Else
MsgBox (sheet.Cells(Row, 2) & " nicht gefunden")
End If
Next Row
Um das alles nochmal zusammenzufassen, ich weiß nicht wie ich an die Namen der aufgeführten Dateien im HTML Dokument komme.
Wenn ich die Namen der Dateien erstmal habe, könnte ich auch weitermachen und die HTML-Doks mit passendem Anhang in einen Ordner kopieren.
Ich hoffe ihr verstehe was ich meine, für Fragen stehe ich gerne zu verfügung.
Grüße
Chris
4 Antworten
Würde es reichen, wenn man in den html-Dateien einfach nach <td colspan="5"> sucht und dann die zweite Zeile danach einliest?
Oder vielleicht auch nach einer Zeile, die mit <a name="attachments" id="attachments"> anfängt, und dann die dritte Zeile danach einliest?
Das würde die Sache zumindest deutlich einfacher machen.
Mein Code fängt nach dem Kopieren der Datei an, die Datei zu durchsuchen und die Daten auszulesen. Das hier ist zwar ungetestet, aber falls Fehler auftreten, kannst du die wahrscheinlich alleine beheben:
Const path = "M:*"
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Worksheets(2)
maxRow = sheet.Cells(sheet.Rows.count, "B").End(xlUp).row
Dim id As String
Dim sourcePath As String
Dim destPath As String
Dim Filename As String
' ### neue Variablen
Dim FileNr As Long
Dim found As Boolean
Dim currentLine As String
For row = 2 To maxRow
sourcePath = path & "view.php-id=" & sheet.Cells(row, 2) & ".html"
Filename = "view.php-id=" & sheet.Cells(row, 2) & ".html"
MkDir (path & "gefunden\" & sheet.Cells(row, 2))
destPath = path & "gefunden\" & sheet.Cells(row, 2) & "\" & sheet.Cells(row, 2) & ".html"
If Dir(sourcePath) = Filename Then
FileCopy sourcePath, destPath
FileNr = FreeFile
found = False
Open destPath For Input As #FileNr
While Not found And Not EOF(FileNr)
Line Input #FileNr, currentLine
If Left(Trim(currentLine), 39) = "<a name=""attachments"" id=""attachments"">" Then
Line Input #FileNr, currentLine ' nächste Zeile
Line Input #FileNr, currentLine ' nächste Zeile
Line Input #FileNr, currentLine ' nächste Zeile
' ### Beispiel: Alles zwischen den <a> Tags in Spalte 3 der aktuellen Excel-Zeile schreiben
sheet.Cells(row, 3).Value = Mid(Trim(currentLine), 4, Len(Trim(currentLine)) - 7)
found = True
End If
Wend
Close #FileNr
Else
MsgBox (sheet.Cells(row, 2) & " nicht gefunden")
End If
Next row
Und was genau macht folgende Line? Wofür steht die 39?
If Left(Trim(currentLine), 39) = "<a name=""attachments"" id=""attachments"">" Then
Ah, ok. Ja, ich wusste nicht, wie das in der Html aussieht, wenn mehrere Anhänge drin sind. Ich dachte, da ändert sich nur die Zeile, wo "attachments" drinsteht.
Ja, dieses Open destPath For Input As #FileNr öffnet eine Datei so, dass sie mit Line Input eingelesen werden kann. Ist eigentlich eine veraltete Funktion, genau wie Dir(), aber sie funktioniert trotzdem gut und ich finde sie einfacher, als mit irgendwelchen FileSystemObject rumzumachen.
In currentLine steht ja die aktuelle Textzeile drin. Mit Trim() werden führende und endende Leerzeichen abgeschnitten. Das Left( ... , 39) heißt, dass er sich die ersten 39 Zeichen dieser Zeile nehmen soll und die vergleicht er danach halt mit "<a name=""attachments"" id=""attachments"">". Wenn ich da nichts falsch gemacht hab, sollte das in der HTML 39 Zeichen lang sein.
Ah ok ich verstehe. Ich Probier das die Tage aus und melde mich dann wahrscheinlich nochmal bei dir ;)
Habs gerade mal schnell im Einzelschrittmodus versucht, der vergleicht iwie immer nur die erste Zeile im HTML Dokument mit "<a name=""atachments"" id="" ..usw.
Und geht dann direkt weiter zur nächsten HTML_Datei
Also der Prüft einmal, springt dann auf End If -> Wend -> Dann wieder oben ins While und dann prüft der aber nicht mehr sondern macht direkt Close #FileNr und springt zum nächstem Dokument.
Hmm, kann sein, dass er die Datei nicht findet. So, wie es im Code steht, ist destPath ja irgendwas in die Richtung "M:*gefunden\4711\4711.html". Das ist aber kein gültiger Pfad. Zumindest das Sternchen müsste mit einem Backslash getauscht werden.
Wenn du die Funktion in Einzelschritten durchgehst, dann schau nach der Zeile mit dem Line Input mal, was in currentLine drinsteht.
Ne das ist nicht das Problem. Bin nochmal durchgegangen und der hat den richtigen destPath. Er greift auch auf die Datei zu, weil beim durchlaufen der while, zeigt er mir currentline=<doctype html> .. usw.
Aber es wird halt auch nur diese erste Zeile geprüft und danach die while Bedingung beendet.
If, while, if, end if, wend, while, Close #fileNr, end if
Oben ist die Abfolge die das Makro durchläuft.
Danach wird die For-Schleife mit der nächsten Reihe fortgesetzt.
Hmm, das ist echt komisch. Ich finde im Code keinen Fehler.
Eine Idee hab ich noch: VBA erwartet als Zeilenende-Zeichen immer ein Cr Lf (das sind zwei ASCII-Steuerzeichen. Wagenrücklauf und neue Zeile. In vielen anderen Programmiersprachen auch mit \r\n gekennzeichnet). Es kann aber sein, dass die HTML-Dokumente nur eins der Zeichen benutzen. In der Regel ist das dann nur Lf. Dadurch würde VBA mit dem Befehl "Line Input" gleich das gesamte Dokument einlesen, obwohl es ja nur zeilenweise durchgehen soll.
Ich hab jetzt nochmal einige Änderungen am Code vorgenommen. Wenn meine Vermutung stimmt, sollte in die Variable "completeFile" die ganze HTML eingelesen werden, dann in ein Array geschrieben und von da aus zeilenweise durchgegangen werden. Ich hab den Code jetzt auch so erweitert, dass mehrere Attachments aus einer Datei ausgelesen werden können.
Das "Option Explicit" am Anfang des Codes sorgt dafür, dass alle Variablen initialisiert werden müssen. Wenn VBA eine Variable noch nicht kennt, wird eine Fehlermeldung angezeigt. Das hilft oft, um Schreibfehler zu finden.
Option Explicit
Sub test()
Dim path As String
path = "M:*"
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Worksheets(2)
Dim maxRow As Long
Dim Row As Long
maxRow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
Dim id As String
Dim sourcePath As String
Dim destPath As String
Dim Filename As String
' ### neue Variablen
Dim FileNr As Long
Dim found As Boolean
Dim currentLine As String
Dim completeFile As String
Dim fileLines() As String
Dim lineNr As Long
Dim attachmentColumn As Integer
For Row = 2 To maxRow
sourcePath = path & "view.php-id=" & sheet.Cells(Row, 2) & ".html"
Filename = "view.php-id=" & sheet.Cells(Row, 2) & ".html"
MkDir (path & "gefunden\" & sheet.Cells(Row, 2))
destPath = path & "gefunden\" & sheet.Cells(Row, 2) & "\" & sheet.Cells(Row, 2) & ".html"
If Dir(sourcePath) = Filename Then
FileCopy sourcePath, destPath
' Alles in die Variable completeFile einlesen (falls meine Vermutung stimmt)
FileNr = FreeFile
found = False
Open destPath For Input As #FileNr
Line Input #FileNr, completeFile
Close #FileNr
' die Daten aus completeFile pro Zeile in fileLines schreiben. Falls es mit vbLf nicht funktioniert, kannst du auch vbCr probieren.
fileLines = Split(completeFile, vbLf)
' Jede Zeile durchgehen, nach der attachments-Zeile suchen und alle gefundenen attachments in die Excel schreiben
For lineNr = 0 To UBound(fileLines)
If Not found Then
currentLine = Trim(fileLines(lineNr))
If Left(currentLine, 39) = "<a name=""attachments"" id=""attachments"">" Then
lineNr = lineNr + 3
attachmentColumn = 3
While Left(Trim(fileLines(lineNr)), 3) = "<a>"
' ### Beispiel: Alles zwischen den <a> Tags ab Spalte 3 der aktuellen Excel-Zeile schreiben
currentLine = Trim(fileLines(lineNr))
sheet.Cells(Row, attachmentColumn).Value = Mid(Trim(currentLine), 4, Len(Trim(currentLine)) - 7)
lineNr = lineNr + 3
attachmentColumn = attachmentColumn + 1
Wend
found = True
End If
End If
Next lineNr
Else
MsgBox (sheet.Cells(Row, 2) & " nicht gefunden")
End If
Next Row
End Sub
Hey vielen Dank für deine Mühe, das mit den einzelnen Zeilen in ein Array lesen funktioniert. Allerdings schreibt er mir nichts in die dritte Spalte. Ich habe mir die HTML-Datei nochmal angeschaut, ich glaube es liegt daran, dass die Line nicht mit "<a name=""attachments"" .. usw. anfängt. Das ist nur ein Teil in dieser Zeile und dahinter stehen die Informationen. Davor sind zich <td> und <tr> Tags, aber die will ich ja nicht alle im Makrocode haben.
Also:
Zeilenstart [...] <a name="attachments" id="attachments">Angehängte Dateien</a></td><td colspan="5"> und dann immer <a> <img></a>
Habe versucht das Trennwort durch folgendes zu ersetzen: <td class=""category"">, weil das immer genau vor <a name="attachments" id="attachments" usw. steht, aber dann bekomme ich den Fehler: "Index außerhalb des gültigen Bereichs." Markiert wird folgende Zeile: While Left(Trim(fileLines(lineNr)), 3) = "<a>". Zuvor steht in Currentline die gesuchte richtige Zeil, dabei war die lineNr 34. Wenn der Fehler auftritt ist lineNr 37 wegen den +3 aus dieser Zeile lineNr = lineNr + 3
Allerdings klappt es auch nicht wenn man "If Left(currentline, 1666) = "[Und hier dann alle 1666 Zeichen die vor den wichtigen Dateien in der Zeile stehen" benutzt, da der Bezeichner dann zu lang ist :/
Ok, das ist ja schonmal ein Anfang. Wenn du eine andere Zeile zum suchen benutzt, muss natürlich auch das "lineNr = lineNr + 3" so angepasst werden, dass du nach dem Sprung wieder in der Zeile bist, wo die Daten stehen, die ausgelesen werden sollen. Wenn der Code einmal die gesuchte Zeile gefunden hat, sollten die Daten in Spalte 3 der aktuellen Excel-Zeile gespeichert werden, dann geht er im HTML drei Zeilen weiter und guckt, ob die Zeile auch mit "<a>" anfängt. Wenn ja, schreibt er die Daten in Spalte 4 und sucht wieder weiter.
Wenn natürlich nach dem letzten "<a>" keine drei Zeilen mehr übrig sind, kommt die Fehlermeldung "Index außerhalb des gültigen Bereichs." Die Meldung heißt im Prinzip, dass der Code auf eine lineNr zugreifen will, die es nicht gibt.
Das könnte man umgehen, indem man statt While Left(Trim(fileLines(lineNr)), 3) = "<a>" erstmal nur prüft, ob es die Zeile gibt (While lineNr <= ubound(fileLines)) und danach erst prüft, ob es mit "<a>" anfängt (if Left(Trim(fileLines(lineNr)), 3) = "<a>").
Alternativ könnte man den Code auch noch so ändern, dass das Array nicht pro Zeilenumbruch gefüllt wird, sondern pro "<" Zeichen, also für jeden HTML-Tag einen eigenen Eintrag im Array. Dadurch könnte man das Problem umgehen, dass mehrere Befehle in einer Zeile stehen.
Zu lang dürfte der Bezeichner bei 1666 Zeichen nicht sein. Die Left-Funktion kann soweit ich weiß ein komplettes String durchsuchen und das hat eine maximale Länge von 2.147.483.648 Zeichen.
Ich habe herausgefunden, dass vor allen Anhängen immer folgendes steht:
type=bug">ANHANG DEN ICH WISSEN WILL</a>
Ich habe jetzt also versucht an der Stelle zu trennen:
fileLines = Split(completeFile, "type=bug")
' Jede Zeile durchgehen, nach der attachments-Zeile suchen und alle gefundenen attachments in die Excel schreiben
For lineNr = 0 To UBound(fileLines)
If Not found Then
currentLine = Trim(fileLines(lineNr))
If Not Left(currentLine, 10) = """><img src" And Not Left(currentLine, 5) = "<!DOC" And Not Left(currentLine, 7) = " target" Then
Zur Erklärung: Es gibt diese Wortkombi "type=bug" nur vor bildern, vor dem Wort "target" oder bei den Anhängen. Ich prüfe auf <!DOC, damit der erste Array Eintrag nicht genommen wird.
Und dann weiß ich nicht so ganz wie ich weitermachen soll.
Hier folgt der HTML Teil den ich untersuchen möchte. (XXXX Sind von mir zensiert)
<a href="XXXX&type=bug"><img src="XXXX" alt="xls file icon" width="16" height="16" border="0"></a> <a href="XXXX&type=bug">DAS WILL ICH HABEN</a> [<a href="XXXX&type=bug" target="_blank">^</a>] (445,952 Bytes) <span class="italic">XXXX</span><br>
<a href="XXXX&type=bug"><img src="XXXX" alt="docx file icon" width="16" height="16" border="0"></a> <a href="XXXX&type=bug">DAS WILL ICH HABEN</a> [<a href="XXXX&type=bug" target="_blank">^</a>] (881,807 Bytes) <span class="italic">XXXX</span><br>
<a href="XXXX&type=bug"><img src="XXXX" alt="xls file icon" width="16" height="16" border="0"></a> <a href="XXXX&type=bug">DAS WILL ICH HABEN</a> [<a href="XXXX&type=bug" target="_blank">^</a>]
Falls dieses: type="bug" nicht im HTML vorhanden ist, dann sind auch keine Anhänge in der Datei die ich rausfiltern will.
Wäre eine riesen Hilfe wenn du mir dabei helfen könntest.
Gruß
Achso. Die einzelnen <a> ... </a> Abschnitte stehen also gar nicht jeweils in einer eigenen Zeile, sondern es sind immer drei Tags, die zusammen in einer Zeile stehen. Und es steht mehr drin, als nur <a>. Wäre natürlich nicht schlecht gewesen, das gleich zu wissen.
Dann muss man da doch nochmal ein bisschen basteln. Gibt es noch andere Stellen im Code, wo eckige Klammern auftauchen? Wenn nicht, könnte man nämlich einfach nach </a> [<a href= suchen und von da aus rückwarts nach dem ersten > suchen.
Ich hab den Code jetzt nochmal so geändert, dass er gar nicht zeilenweise durchgegangen wird, sondern einfach nach </a> [<a href= durchsucht wird, bis davon keins mehr gefunden wird.
Option Explicit
Sub test()
Dim path As String
path = "M:*"
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Worksheets(2)
Dim maxRow As Long
Dim Row As Long
maxRow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
Dim id As String
Dim sourcePath As String
Dim destPath As String
Dim Filename As String
' ### neue Variablen
Dim FileNr As Long
Dim completeFile As String
Dim searchIndex As Long
Dim copyStartIndex As Long
Dim copyEndIndex As Long
Dim attachmentColumn As Integer
For Row = 2 To maxRow
sourcePath = path & "view.php-id=" & sheet.Cells(Row, 2) & ".html"
Filename = "view.php-id=" & sheet.Cells(Row, 2) & ".html"
MkDir (path & "gefunden\" & sheet.Cells(Row, 2))
destPath = path & "gefunden\" & sheet.Cells(Row, 2) & "\" & sheet.Cells(Row, 2) & ".html"
If Dir(sourcePath) = Filename Then
FileCopy sourcePath, destPath
' Alles in die Variable completeFile einlesen
FileNr = FreeFile
found = False
Open destPath For Input As #FileNr
Line Input #FileNr, completeFile
Close #FileNr
' Suchschleife vorbereiten
searchIndex = 1
attachmentColumn = 3
While InStr(searchIndex, completeFile, "</a> [<a href=") > 0 And searchIndex < Len(completeFile)
' nach '</a> [<a href=' suchen
copyEndIndex = InStr(searchIndex, completeFile, "</a> [<a href=")
searchIndex = copyEndIndex + 1
' rückwärts nach '>' suchen
copyStartIndex = InStrRev(completeFile, ">", searchIndex)
' Daten kopieren
If copyStartIndex > 0 Then
sheet.Cells(Row, attachmentColumn) = Mid(completeFile, copyStartIndex + 1, copyEndIndex - 1)
attachmentColumn = attachmentColumn + 1
End If
Wend
Else
MsgBox (sheet.Cells(Row, 2) & " nicht gefunden")
End If
Next Row
End Sub
Ich bin dir sehr dankbar, dein Code hilft mir sehr weiter. Es gibt noch ein paar Dinge die ich jetzt machen muss, aber die werde ich erstmal selber versuchen. Ich werde hier dann mal berichten wie mein Code zum Schluss aussieht. Tausend Dank!!!
Vielleicht noch eine kleine Sache :D
Wie wandle Ich Umlaute aus dem HTML-Dokument um ?
Hab mir das mal in Excel ausgegeben und ein Ä wird z.B. so dargestellt: "ä"
Das wird dann bei der Pfad suche natürlich nicht gefunden. Da gibt es doch bestimmt schon eine fertige Funktion die das macht, oder muss ich das selbst via replace machen?
Da kann ich dir leider aus dem Stegreif nicht weiterhelfen. Ich hab mal bei Google nach dem Problem gesucht. Da steht, dass man z.B. die Funktion MultiByteToWideChar aus der Windows-Systembibliothek einbinden kann, aber das ist meiner Meinung nach komplizierter, als einfach eine Übersetzungsfunktion zu bauen, die mit der Replace-Funktion diese ä nach Ä umwandelt. Du musst halt nur alle Vorkommen von Umlauten finden, damit du die Übersetzung bauen kannst.
Private Function umlauteErsetzen(strIn As String)
Dim strOut As String
strOut = strIn
' Diese Zeile für jeden Umlaut kopieren
strOut = Replace(strOut, "ä", "Ä")
umlauteErsetzen = strOut
End Function
Dann kannst du bei der Zeile, die die Daten ins Tabellenblatt kopiert, zwischen Gleich-Zeichen und "Mid" einfach die Funktion umlauteErsetzen einfügen.
Da es sich um HTML Dateien handelt würde ich die entsprechenden Objekte nutzen, die Über Referenzen:
Dim objDoc As MSHTML.HTMLDocument
Die HTML Datei diesem Objekt zuordnen und dann mit den Zugrifffunktionen die Knoten ansprechen.
In deinem Fall <td> sieht nach den Innereien einer Tabelle aus, die mit <tr> …</tr> die einzelnen Zeilen aufspannt. Wenn man nun den Tabellen start als Knoten Wählt kann man über die gefundene Zeilenanzahl iterieren und sehr analog wie mit
Cells(reihe,Spalte) auch auf die HTML Tabelle zugreifen.
.document.getElementsByClassName("tablename")
Du kannst sie mit einer Regexp (Rugular Expression) durchgehen nach</td> suchen,dir die inhalte ausgebenlassen und dann mit if wasauchimmer <>"" then Abspeichern.
Für die verwendung von regexp muss ein verweis hinzugefügt werden:
Microsoft VBScript Regulat Expression 5.5
ist die schnellste und schönste möglichkeit leider aber auch die komplizierteste
Aber dafür ist sie dynamisch und du musst keine zeilen usw. angeben.
Also egal ob hardcodet oder nicht es wird funktionieren ;)
Ich würde nach einem Teilstring suchen:
<td colspan="5">
dann kann ich einen Unterstring isolieren:
<a> unwichtig </a>
<a> WICHTIG </a> <- Hier steht der gesuchte Dateiname
<a> Unwichtig </a>
dann suche ich nach </a> und das erste was ich finde beinhaltet
<a> WICHTIG
Ja das habe ich auch gedacht. Man nimmt einen String, der in allen Dateien gleich ist und findet dann darüber den passenden <a>-Tag.
Aber ich bin unsicher wie ich das anstelle, vorallem wenn da mehrere Dateien Drin sind. Bei 3 Dateien wäre der aufbau ja wie folgt:
<td>
<a></a>
<a></a> wichtig
<a></a>
<a></a>
<a></a> wichtig
<a></a>
<a></a>
<a></a> wichtig
<a></a>
</td>
Wenn das immer so aufgebaut ist, dann kannst du sagen
Wenn <a> gefunden wird nimm erst mal die 3 aufeinander folgende <a>'s als block- sollten keine 3 verfügbar sein, dann abbruch
und dann von dem Block in den 3 nimm die Mittlere...
ich würde das in AutoIt für 5 min basteln, aber ich brauche eine HTML Datei mit anonymisierten daten...
Hey vielen Dank für deine Antwort. Ich werde das am Montag testen, muss jetzt leider erst weg.
Also ein Problem dabei ist denke ich, wenn mehrere Anhänge in der HTML Datei stehen. Dann würde ich ja mit deinem Code wahrscheinlich immer nur an den ersten Eintrag kommen oder?
Wie oben beschrieben sind manchmal in einer HTML Datei mehrere Anhänge aufgeführt. Dadurch ändert sich die Anordnung wie folgt:
<td>
<a></a>
<a></a> wichtig
<a></a>
<a></a>
<a></a> wichtig
<a></a>
<a></a>
<a></a> wichtig
Was macht die Zeile? Öffnet Sie einfach nur das HTML-Dok?
<a></a>