Öffne eine Email mit dem besagten Content ... packe die folgende Zeilen in das Klassenmodul 'ThisOutlookSession'.
Klicke in die Prozedur main() und gehe den Code zeilenweise via F8 durch.
Beobachte die Entwicklung der Variableninhalte im Lokalen Anhzeigefenster (wenn nicht eingeblendet, dann im VBE über Symbolleiste Ansicht einblenden)
Der Rückgabewert ist ein 2DArray.
Versuche nun das 2dArray zu "holen" und an die passende Stelle im Worksheet zu schreiben.
Ohne Fleiß keinen Preis ... weisst ja ;)
Function get2DArrayFromTableConten() As Variant
'*** Benötigter Verweise über Extras -> Verweise setzen:
'*** Microsoft HTML Object Library
Dim vRet() As Variant 'Returnvalue
Dim htmlDOC As New MSHTML.HTMLDocument 'HTMLBody Deiner EMail, welche die Tabelle hält
Dim htmlTbl As MSHTML.IHTMLTable 'Objecktvariable für die Tabelle <TABLE>-Tag
Dim htmlTblRow As MSHTML.IHTMLTableRow '[...] für die Zeile <TR>-Tag
Dim htmlTblCell As MSHTML.IHTMLTableCell '[...] für die Zelle <TD>-Tag
Dim lRow As Long: lRow = 1 'Laufvariable für Zeile; Achtung: einsbasiert wg Excel.Range
Dim lCol As Long: lCol = 1 '[...] für Spalte; [...]
'*** HTMLDocument -> ggf. anpassen bzw an Functionkopf als Parameter deklarierbar -> universaler
htmlDOC.Body.innerHTML = ActiveInspector.CurrentItem.HTMLBody
'*** HTMLTable(0) -> [...]
Set htmlTbl = htmlDOC.all.tags("table").Item(0)
'*** ReDim ... aufgepasst; die zweite Dimesion dynamisch anzupassen überlasse ich dir ;)
ReDim vRet(1 To htmlTbl.Rows.Length, 1 To 5)
'*** Loopthrough and feed 2DArray
For Each htmlTblRow In htmlTbl.Rows
For Each htmlTblCell In htmlTblRow.Cells
vRet(lRow, lCol) = htmlTblCell.innerText
lCol = lCol + 1
Next
'*** Laufvariablen preset
lCol = 1: lRow = lRow + 1
Next
'*** Return
get2DArrayFromTableConten = vRet
End Function
Sub main()
Dim vRet As Variant
vRet = get2DArrayFromTableConten
End Sub
|