Option
Explicit
Sub
Test()
Dim
strMailContent
As
String
With
CreateObject(
"ADODB.Stream"
)
.Charset =
"utf-8"
Call
.Open
Call
.LoadFromFile(Environ$(
"USERPROFILE"
) &
"\Desktop\mail.html.msg"
)
strMailContent = .ReadText()
End
With
Dim
objHTML
As
MSHTML.HTMLDocument
Dim
vntTable
As
Variant
Set
objHTML =
New
MSHTML.HTMLDocument
Call
CallByName(objHTML,
"writeln"
, VbMethod, strMailContent)
With
objHTML.DocumentElement
With
.getElementsByTagName(
"TABLE"
)
If
.Length > 0
Then
vntTable = HTMLTable2Array(.Item(0))
Call
DebugPrintTable(vntTable)
Else
Call
MsgBox(
"Table not found"
)
End
If
End
With
End
With
End
Sub
Private
Function
DebugPrintTable(TableData
As
Variant
)
As
Variant
Dim
i
As
Long
, n
As
Long
For
i = 0
To
UBound(TableData)
n = WorksheetFunction.Max(n, Len(TableData(i, 0)))
Next
For
i = 0
To
UBound(TableData)
Debug.Print TableData(i, 0); Tab(n + 4); TableData(i, 1)
Next
End
Function
Private
Function
HTMLTable2Array(HTMLTable
As
MSHTML.HTMLTable)
As
Variant
Dim
i
As
Long
Dim
j
As
Long
On
Error
GoTo
ErrHandler
i = HTMLTable.Rows.Length
j = HTMLTable.Rows(0).Cells.Length
ReDim
vntData(0
To
j - 1, 0
To
i - 1)
As
String
Dim
tableRow
As
MSHTML.HTMLTableRow
Dim
tableCell
As
MSHTML.HTMLTableCell
For
Each
tableRow
In
HTMLTable.Rows
For
Each
tableCell
In
tableRow.Cells
vntData(tableCell.cellIndex, tableRow.RowIndex) = Trim$(tableCell.innerText)
Next
Next
HTMLTable2Array = vntData
Exit
Function
ErrHandler:
vntData = Split(
""
)
End
Function