i am using VBA Excel to exporting tables from body code works fine till today I found so missing mails such as I have 18 mails at 5-Sep but code get only two mails , i exporting from send items even if i try export from Inbox first mail received time 8-Sep but i have like 10+ mails today 11-sep
Sub ExtractTablesDataFromOutlookEmails()
Range("A1:K50000").Clear
Dim OLApp As Outlook.Application
Set OLApp = New Outlook.Application
Dim StartDate As Date, EndDate As Date
Dim ONS As Outlook.Namespace
Set ONS = OLApp.GetNamespace("MAPI")
Dim MYFOLDER As Outlook.Folder
Set MYFOLDER = ONS.Folders("XXXX@XXXX.com").Folders("Send Items")
Dim OLMAIL As Outlook.MailItem
Set OLMAIL = OLApp.CreateItem(olMailItem)
For Each OLMAIL In MYFOLDER.Items
Dim oHTML As MSHTML.HTMLDocument
Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
With oHTML
.body.innerHTML = OLMAIL.HTMLBody
Set oElColl = .getElementsByTagName("table")
End With
Dim t As Long, r As Long, c As Long
Dim eRow As Long
eRow = Sheets(1).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row + 3
ThisWorkbook.Sheets("sheet1").Cells(eRow, 1) = "Sender's Name:" & " " & OLMAIL.Sender
ThisWorkbook.Sheets("sheet1").Cells(eRow, 1).Interior.Color = vbRed
ThisWorkbook.Sheets("sheet1").Cells(eRow, 1).Font.Color = vbWhite
ThisWorkbook.Sheets("sheet1").Cells(eRow, 2) = "Date & Time of Receipt:" & " " & OLMAIL.ReceivedTime
ThisWorkbook.Sheets("sheet1").Cells(eRow, 2).Interior.Color = vbBlue
ThisWorkbook.Sheets("sheet1").Cells(eRow, 2).Font.Color = vbWhite
If (InStr(1, OLMAIL.body, "Mohamed Youssef", vbTextCompare) > 1) Then
ThisWorkbook.Sheets("sheet1").Cells(eRow, 3) = "Mohamed Youssef"
ElseIf (InStr(1, OLMAIL.body, "Mohamed HAMZA", vbTextCompare) > 1) Then
ThisWorkbook.Sheets("sheet1").Cells(eRow, 3) = "Mohamed HAMZA"
ElseIf (InStr(1, OLMAIL.body, "Hitham Emad", vbTextCompare) > 1) Then
ThisWorkbook.Sheets("sheet1").Cells(eRow, 3) = "Hitham Emad"
ElseIf (InStr(1, OLMAIL.body, "Mostafa Rizk", vbTextCompare) > 1) Then
ThisWorkbook.Sheets("sheet1").Cells(eRow, 3) = "Mostafa Rizk"
End If
ThisWorkbook.Sheets("sheet1").Cells(eRow, 3).Interior.Color = vbGreen
ThisWorkbook.Sheets("sheet1").Cells(eRow, 3).Font.Color = vbBlack
For t = 0 To oElColl.Length - 1
eRow = Sheets(1).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row + 3
For r = 0 To (oElColl(t).Rows.Length - 1)
For c = 0 To (oElColl(t).Rows(r).Cells.Length - 1)
Range("D" & eRow).Offset(r, c).Value = oElColl(t).Rows(r).Cells(c).innerText
Next c
Next r
eRow = Sheets(1).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row + 3
Next t
Next OLMAIL
Range(“A1”).Select
Set OLApp = Nothing
Set OLMAIL = Nothing
Set oHTML = Nothing
Set oElColl = Nothing
ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
End Sub