kaiuwe28
Goto Top

Excel VBA - Tabelle aus E-Mail (HTMLBody) soll nach Excel exportiert werden

Hallo zusammen,

ich komme bei der Fehlerbehebung des u.a. Skriptes nicht weiter.
Bei dem Script handelt es sich um 2 Skripte, welche wir bereits mal genutzt hatten und jetzt in einen zusammen fassen wollten.
Ein Script war jedoch für Outlook und eins war für Excel.

Das neue Script soll in Excel gestartet werden. Ziel ist es E-Mails mit einen bestimmten Betreff und einen Datumsbereich auszulesen und die Tabelle aus dem HTML Body ab der ersten Zeile mit einem Datum wiederzugeben.

Der Fehler kommt bei "oDom.Write itm.HTMLBody" und sagt, dass die Variable nicht korrekt formuliert ist. "Objectvariable oder With-Blockvatriable nicht festgelegt."

Kann mir jemand sagen, wie ich korrekt deklarieren muss und ob der Rest dann korrekt zusammengestellt wurde?

Vielen Dank im voraus.

Sub ExtractTableDataToExcelGlobal()

    'Variablen  
    Dim oDom As Object, arr() As Variant, r As Integer, c As Integer, intStart As Integer, intEnd As Integer
    Dim olOrdner As Outlook.MAPIFolder
    Dim AnzahlEmail As Integer, z As Integer, i As Integer, Email As Integer, a As Long
    Dim VonDatum As Date, BisDatum As Date
    Dim itm As Outlook.MailItem
    
    'benötigte Objekte erstellen  
    Set oDom = CreateObject("htmlfile")  
    Set objExcel = CreateObject("Excel.Application")  
    Set regex = CreateObject("vbscript.regexp"): regex.IgnoreCase = True  


'Setzen der Variable als Outlook Application; Zugriff auf Outlook  
Set olOrdner = GetObject("", "Outlook.Application").GetNamespace("MAPI").Folders("tfs@tfs.com").Folders("Posteingang").Folders("System Global Verarbeitung")  
   

'Setzen der Variable -> es sollen alle Nachrichten im Ordner 'Posteingang (olFolderInbox) gezählt werden  
AnzahlEmail = olOrdner.Items.Count

VonDatum = InputBox("Bitte Datum des ersten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now - 1, "DD.MM.YYYY"))  
BisDatum = InputBox("Bitte Datum des letzten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now, "DD.MM.YYYY  23:59:59"))  

'Beginn Schleifendurchlauf (Schleife 1)  -> die Variable 'i' läuft solange, wie Anzahl der EMails vorhanden sind  
While i < AnzahlEmail
    i = i + 1

    'Anzeigen einer Nachricht in der Statuszeile  
    Application.StatusBar = "Lese Posteingang " & _  
        Format(i / AnzahlEmail, "0%")  
        'Was soll mit den Nachrichten geschehen?  (Schleife 2)  
    
        With olOrdner.Items(i)
            regex.Pattern = "^FW: Verarbeitung System Global"  
                If regex.test(.Subject) And .ReceivedTime >= VonDatum And .ReceivedTime <= BisDatum Then
                
    'HTML Tabellendaten in zweidimensionales Excel-Array einlesen  
    oDom.Write itm.HTMLBody
    With oDom.getElementsByTagName("table")(0)  
        'Prüfe auf ein Datum in der ersten Zelle um den Anfang der Datenzeilen zu erkennen  
        regex.Pattern = "^\d{2}\.\d{2}\.\d{4}$"  
        For z = 0 To .Rows.Length - 1
            'Wenn Datum erkannt wurde  
            If regex.test(Trim(.Rows(z).Cells(0).innerText)) Then
                If intStart = 0 Then
                    'Startzeile wurde noch nicht gesetzt  
                    intStart = z
                Else
                    'Endzeile setzen wenn Startzeile schon gesetzt wurde  
                    intEnd = z
                End If
            End If
        Next
        'Ändere Größe des Arrays passend der Anzahl Zeilen und Spalten  
        ReDim arr(0 To (intEnd - intStart), 0 To 7)
        'Durchlaufe nur die Datenzeilen und schreibe die Zelldaten ins Array  
        For r = intStart To intEnd
            For c = 0 To 7
                arr(r - intStart, c) = Trim(.Rows(r).Cells(c).innerText)
            Next
        Next
    End With

            End If
        'Ende der Schleife 2  
        Debug.Print Email
        End With

    
'Ende der Schleife 1  
Wend
 
    'Daten in nächste freie Zelle schreiben  
    With Sheets("Global")  
        .Cells(.Rows.Count, "A").End(-4162).Offset(1, 0).Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr  
    End With
    
    'Cleanup  
    Set regex = Nothing
    Set oDom = Nothing
    Set olOrdner = Nothing
        
End Sub

Content-Key: 365199

Url: https://administrator.de/contentid/365199

Ausgedruckt am: 29.03.2024 um 13:03 Uhr

Mitglied: 135333
Lösung 135333 19.02.2018 aktualisiert um 13:23:55 Uhr
Goto Top
oDom.Write itm.HTMLBody
Ist ja auch klar, itm gibt's nirgendwo also die Eigenschaft der Mail nehmen die du dort schon mit dem With Statement referenziert hast.
oDom.Write .HTMLBody 
Mitglied: kaiuwe28
kaiuwe28 19.02.2018 um 13:54:59 Uhr
Goto Top
Manchmal kann die Lösung auch so einfach sein face-smile

Danke dir!