hearthhrob4gals
Board Regular
- Joined
- Aug 20, 2014
- Messages
- 142
Hi,
I have a code wherein it extracts details from emails from an inbox along with the mail body.
The code works perfectly fine. However, i added new lines of code for retaining the html format of the tables inside the mail body. However, its not picking up anything.
Any help on this would be highly appreciated
I have a code wherein it extracts details from emails from an inbox along with the mail body.
The code works perfectly fine. However, i added new lines of code for retaining the html format of the tables inside the mail body. However, its not picking up anything.
Any help on this would be highly appreciated
VBA Code:
Sub mytry()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String
Const num As Integer = 6
Const path As String = "C:\Users\u248087\Desktop\JE\"
Const emailpath As String = "C:\Users\u248087\Desktop\JE\"
Const olFolderInbox As Integer = 6
Set olp = CreateObject("outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)
Set olmail = olmail.Folders("IMP")
If olmail.items.restrict("[UNREAD]=True").Count = 0 Then
MsgBox ("No Unread mails")
Else
For Each olitem In olmail.items.restrict("[UNREAD]=True")
lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & lrow).Value = olitem.Subject
Range("B" & lrow).Value = olitem.senderemailaddress
Range("C" & lrow).Value = olitem.To
Range("D" & lrow).Value = olitem.cc
' Range("E" & lrow).Value = olitem.Body
Range("F" & lrow).Value = olitem.ReceivedTime
Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
With oHTML
.Body.innerHTML = olitem.HTMLBody
Set oElColl = .getElementsByTagName("table")
End With
'import in Excel
Dim x As Long, y As Long
For x = 0 To oElColl(0).Rows.Length - 1
For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
Range("E1").Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
Next y
Next x
End If
ActiveSheet.Rows.WrapText = False
End Sub