-1

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
Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45

1 Answers1

0

Iterating through all items in the folder is not really a good idea:

For Each OLMAIL In MYFOLDER.Items

Instead of using multiple conditions in the for loop:

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

You need to use the Find/FindNext or Restrict methods of the Items class to get only items that correspond to your search criteria. In that case you will be iterate over items that you are interested in. Read more about these methods in the articles I wrote for the technical blog:

Be aware, Outlook folders may contain different types of items - appointments, tasks, notes, documents and etc. So, it makes sense to check the item type before accessing type-specific property. Otherwise, you may get an error at runtime.

So, in the code you define the OLMAIL object as MailItem and iterate over all items in the folder:

Dim OLMAIL As Outlook.MailItem

Instead, you need to declare it as object to be able to deal with any type of items in Outlook.

Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
  • If (InStr(1, OLMAIL.body, "Mohamed Youssef", vbTextCompare) > 1) Then <<<<< i use it to find the signature because we use e-mail for mulit person and if i remove those lines i still get missing mails – Ebram Shehata Sep 12 '22 at 19:48
  • Did you try to iterate over objects, not mail item. Try to check the item type at runtime by checking the Class property. – Eugene Astafiev Sep 12 '22 at 20:07