Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1652to1656
1652to1656
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Alle HTML Dateien aus Verzeichnis einlesen

Forumthread: Alle HTML Dateien aus Verzeichnis einlesen

Alle HTML Dateien aus Verzeichnis einlesen
18.10.2018 07:42:38
Patrick
Hallo zusammen,
ich hatte vor einiger Zeit hier einen Beitrag erstellt, in dem es darum ging lokale HTML Dateien automatisiert in Excel zu importieren. Dabei wurde mir hier sehr geholfen - vor allem von Zwenn - und mit einer einzelnen Datei funktioniert das auch wunderbar (13.htm).
Nun möchte ich aber nicht nur eine Datei importieren, sondern alle *.htm Dateien eines bestimmten Verzeichnisses (C:\temp) auf einmal. Könnt ihr mir bei der Umsetzung helfen. Es müsste ja mMn nur ein Schleifenkonstrukt integriert werden, aber irgendwie langen meine VBA Kenntnisse dafür nicht.
Außerdem würde ich zusätzlich gerne eine "CASE WHEN" Anweisung für Spalte B integrieren, die sich am Dateinamen orientiert. Enthält dieser "13", dann soll dort "Lager13" stehen, bei "12" "Lager12" usw. Wenn ich das mit IF ELSEIF... versuche, bekomme ich immer eine Fehlermeldung (ohne if Block etc.).
Meine bisherige Datei plus 2 Beispiele habe ich angehänt.
https://www.herber.de/bbs/user/124712.xlsm
https://www.herber.de/bbs/user/124713.htm
https://www.herber.de/bbs/user/124714.htm
Viele Grüße
Patrick
Anzeige

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Alle HTML Dateien aus Verzeichnis einlesen
18.10.2018 09:44:12
Luschi
Hallo Patrick,
ich würde Dir ja helfen, aber mein Internet-Explorer weigert sich, die 2 htm-Dateien einzulesen.
M$-Edge kann sie einlesen, aber dieser neue?! Browser unterstützt die COM-Schnittstelle (Component Object Model) nicht und damit ist der Aufruf:
Set browser = CreateObject("edge.application")
nicht möglich.
Außerdem kann ich mir nicht vorstellen, daß der Code von Zwenn fehlerfrei durchlief, denn:
If sFilePath "" Then GetFileName = StrReverse(Split(StrReverse(sFilePath), "/", -1, vbTextCompare)(0))
kann nicht funktionieren und muß so lauten:
If sFilePath "" Then GetFileName = StrReverse(Split(StrReverse(sFilePath), "\", -1, vbTextCompare)(0))
(Backslash statt Querstrich)
Mein Vorschlag: Zippe die beiden htm-Dateien in eine Datei und lade diese hoch; kann mir gut Vorstellen, daß beim hochladen von hmt/html-Dateien irgendwas schief geht und der IE nicht so fehlertolerant ist wie der Edge.
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Alle HTML Dateien aus Verzeichnis einlesen
18.10.2018 09:54:54
UweD
Hallo
vorab: dateiName = Dir(pfad) reicht schon
LG UweD
AW: Alle HTML Dateien aus Verzeichnis einlesen
18.10.2018 10:03:34
Patrick
Hi Luschi,
der untere Part ist nicht von Zwenn, den habe ich aus dem Netz. Er funktioniert aber einwandfrei. In Spalte B wird ja "13.htm" angezeigt, das entspricht dem Dateinamen. Das zip File lade ich gleich hoch.
AW: Alle HTML Dateien aus Verzeichnis einlesen
18.10.2018 11:27:08
UweD
so?
Modul1 
Sub DatenAusHTML() 
 
    Dim browser As Object 
    Dim url As String 
    Dim knotenAst As Object 
    Dim knotenZweig As Object 
    Dim splitArray() As String 
    Dim i As Long 
    Dim zeile As Long 
    Dim pfad As String 
    Dim ext As String 
    Dim datei As String 
    Dim datum As Date 
    Dim dateiName As String 
 
    pfad = "C:\temp\"   ' keine/ 
    ext = "*.htm" 
     
     
    datei = Dir(pfad & ext) 
    zeile = 5 
     
    Do While Len(datei) > 0 
 
        url = "file:///" & Replace(pfad, "\", "/") & datei 
         
        datum = Format(GetFileDate(pfad & datei), "dd.MM.yyyy") 
         
        Set browser = CreateObject("internetexplorer.application") 
        browser.Visible = False 
        browser.navigate url 
        Do Until browser.readystate = 4: DoEvents: Loop 
         
        Set knotenAst = browser.document.getElementsByTagName("span") 
         
        If Not knotenAst Is Nothing Then 
            For Each knotenZweig In knotenAst 
                If InStr(1, knotenZweig.innertext, "|") > 0 Then 
                    Cells(zeile, 1).Value = datum 
                    Cells(zeile, 2).Value = datei 
                    splitArray = Split(knotenZweig.innertext, "|") 
                    For i = 0 To Ubound(splitArray) 
                        Select Case i 
                            Case 2 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 3).Value = Trim(splitArray(i)) 
                            Case 3 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 4).Value = Trim(splitArray(i)) 
                            Case 6 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 5).Value = Trim(splitArray(i)) 
                            Case 8 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 6).Value = Trim(splitArray(i)) 
                            Case 12 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 8).Value = Trim(splitArray(i)) 
                            Case 10 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 7).Value = Trim(splitArray(i)) 
                        End Select 
                    Next i 
                    zeile = zeile + 1 
                End If 
            Next knotenZweig 
        End If 
        datei = Dir() ' nächste Datei 
    Loop 
     
     
    browser.Quit 
    Set browser = Nothing 
    Set knotenAst = Nothing 
    Set knotenZweig = Nothing 
 
End Sub 
 
Function GetFileDate(ByVal sFilePath As String) As Date 
 
    Dim fso As Object 
    Dim fsFile As Object 
    Dim dReturn As Date 
     
    Set fso = CreateObject("Scripting.FileSystemObject") 
     
    If fso.FileExists(sFilePath) Then 
        Set fsFile = fso.GetFile(sFilePath) 
        dReturn = fsFile.DateCreated 
    Else 
        dReturn = CDate("01.01.1900") 
    End If 
     
    GetFileDate = dReturn 
 
End Function

LG UweD
Anzeige
AW: Alle HTML Dateien aus Verzeichnis einlesen
18.10.2018 11:44:40
Patrick
Hallo Uwe,
funktioniert perfekt, danke vielmals. Kannst du mir eventuell auch noch bei der case when Anweisung unter die Arme greifen, scheinbar mache ich immer einen Fahler bei der Syntax.
AW: Alle HTML Dateien aus Verzeichnis einlesen
18.10.2018 13:00:42
UweD
Hallo
da der Dateiname ja scheinbar schon die 13 oder 12 etc. ist, kann der name direkt verwendet werden.
Abgeschnitten wird das .htm.
3 Änderungen im Code
Modul1 
Sub DatenAusHTML() 
  
    Dim browser As Object 
    Dim url As String 
    Dim knotenAst As Object 
    Dim knotenZweig As Object 
    Dim splitArray() As String 
    Dim i As Long 
    Dim zeile As Long 
    Dim pfad As String 
    Dim ext As String 
    Dim datei As String 
    Dim datum As Date 
    Dim dateiName As String 
  
    pfad = "C:\temp\"   ' keine/ 
    pfad = "x:\temp\test\"   ' keine/ 
    ext = ".htm" 
      
      
    datei = Dir(pfad & "*" & ext) 
    zeile = 5 
      
    Do While Len(datei) > 0 
  
        url = "file:///" & Replace(pfad, "\", "/") & datei 
          
        datum = Format(GetFileDate(pfad & datei), "dd.MM.yyyy") 
          
        Set browser = CreateObject("internetexplorer.application") 
        browser.Visible = False 
        browser.navigate url 
        Do Until browser.readystate = 4: DoEvents: Loop 
          
        Set knotenAst = browser.document.getElementsByTagName("span") 
          
        If Not knotenAst Is Nothing Then 
            For Each knotenZweig In knotenAst 
                If InStr(1, knotenZweig.innertext, "|") > 0 Then 
                    Cells(zeile, 1).Value = datum 
                    Cells(zeile, 2).Value = "Lager" & Replace(datei, ext, "") 
                    splitArray = Split(knotenZweig.innertext, "|") 
                    For i = 0 To Ubound(splitArray) 
                        Select Case i 
                            Case 2 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 3).Value = Trim(splitArray(i)) 
                            Case 3 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 4).Value = Trim(splitArray(i)) 
                            Case 6 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 5).Value = Trim(splitArray(i)) 
                            Case 8 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 6).Value = Trim(splitArray(i)) 
                            Case 12 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 8).Value = Trim(splitArray(i)) 
                            Case 10 
                                splitArray(i) = Replace(splitArray(i), Chr(160), "") 
                                Cells(zeile, 7).Value = Trim(splitArray(i)) 
                        End Select 
                    Next i 
                    zeile = zeile + 1 
                End If 
            Next knotenZweig 
        End If 
        datei = Dir() ' nächste Datei 
    Loop 
      
      
    browser.Quit 
    Set browser = Nothing 
    Set knotenAst = Nothing 
    Set knotenZweig = Nothing 
  
End Sub 
  
Function GetFileDate(ByVal sFilePath As String) As Date 
  
    Dim fso As Object 
    Dim fsFile As Object 
    Dim dReturn As Date 
      
    Set fso = CreateObject("Scripting.FileSystemObject") 
      
    If fso.FileExists(sFilePath) Then 
        Set fsFile = fso.GetFile(sFilePath) 
        dReturn = fsFile.DateCreated 
    Else 
        dReturn = CDate("01.01.1900") 
    End If 
      
    GetFileDate = dReturn 
  
End Function

LG UweD
Anzeige
AW: Alle HTML Dateien aus Verzeichnis einlesen
18.10.2018 14:31:04
Patrick
Ok, vielen Dank für die schnelle Hilfe.
Danke für die Rückmeldung owT
18.10.2018 14:57:53
UweD
AW: Danke für die Rückmeldung owT
22.10.2018 07:45:35
Patrick
Hallo Uwe,
jetzt habe ich doch noch ein paar kleine Anpassungswünsche. Vielleicht kannst du mir dabei auch noch helfen. Der Dateiname ist leider anders und auch die Ausgabe soll anders sein. Ich habe versucht das selbst in einer select case Anweisung umzusetzen, aber es funktioniert nicht.

If Not knotenAst Is Nothing Then
For Each knotenZweig In knotenAst
If InStr(1, knotenZweig.innertext, "|") > 0 Then
Cells(zeile, 1).Value = datum
Select Case InStr(datei)
Case "1.htm"
Cells(zeile, 2).Value = "3772/0010"
Case "2.htm"
Cells(zeile, 2).Value = "3772/0008"
Case "3.htm"
Cells(zeile, 2).Value = "3772/0011"
Case "4.htm"
Cells(zeile, 2).Value = "3772/0015"
Case "5.htm"
Cells(zeile, 2).Value = "2029/0010"
Case "6.htm"
Cells(zeile, 2).Value = "2029/0008"
Case "7.htm"
Cells(zeile, 2).Value = "2020/0010"
Case "8.htm"
Cells(zeile, 2).Value = "2020/0002"
Case "9.htm"
Cells(zeile, 2).Value = "2020/0003"
Case "10.htm"
Cells(zeile, 2).Value = "2020/0004"
Case "11.htm"
Cells(zeile, 2).Value = "2020/0008"
Case "12.htm"
Cells(zeile, 2).Value = "2020/0009"
Case "13.htm"
Cells(zeile, 2).Value = "2011/0010"
Case "14.htm"
Cells(zeile, 2).Value = "2011/0010"
Case "15.htm"
Cells(zeile, 2).Value = "2010/0008"
Case "16.htm"
Cells(zeile, 2).Value = "2052/0010"
Case "17.htm"
Cells(zeile, 2).Value = "2052/0008"
Case Else
Cells(zeile, 2).Value = "UNBEKANNT"
End Select
Kannst du mir sagen wo der Fehler ist?
Außerdem wäre es super, wenn nicht jedes Mal wieder alle Dateien aus dem Verzeichnis erneut ausgelesen werden, sondern nur die, die noch nicht importiert worden sind. Hast du eine Idee wie man das abfangen könnte?
Alle anderen dürfen natürlich auch gerne mit Rat und Tat zur Seite stehen.
Hier die Datei: https://www.herber.de/bbs/user/124796.xlsm
Viele Grüße
Patrick
Anzeige
AW: Danke für die Rückmeldung owT
22.10.2018 11:25:45
Patrick
Das mit der select case Anweisung hat sich mittlerweile erledigt, habe es mit einer if Anweisung gelöst
AW: Danke für die Rückmeldung owT
22.10.2018 13:04:08
UweD
Hallo
ungetestet...

Select Case datei
Case "1.htm"
Cells(zeile, 2).Value = "3772/0010"

AW: Alle HTML Dateien aus Verzeichnis einlesen
18.10.2018 10:04:44
Patrick
Hallo Uwe,
vielen Dank, kannst du das vielleicht direkt in den Code schreiben. Ich bin leider noch nicht so firm mit VBA und wüßte jetzt nicht genau wo und was ich anpassen müsste.
Viele Grüße
Patrick
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige