Q:

Received email date from outlook. Problems with format and search from info in cells

Sub ReceivedEmailDate()
Dim outlookApp
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Dim myTasks
Dim sir() As String

Set outlookApp = CreateObject("Outlook.Application")

Set olNs = outlookApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set myTasks = Fldr.Items

i = 2             'This is the row you want the date/time to start from

For Each olMail In myTasks

                'This is where the search occurs in the outlook inbox (parameters can be altered depending on what you want to search for)
                'I have stated to search for the invoice numbers in the subject field of the email. Invoice numbers located down column E
If (InStr(1, olMail.Subject, ActiveSheet.Cells(i, 5), vbTextCompare) > 0) Then
  ActiveSheet.Cells(i, 8).Value = Format(olMail.ReceivedTime, "DD/MM/YY")      'format function to only show the date, rather than both date and time

  i = i + 1     'Count so that each email date/time is entered in the row below the previous one

End If

Next olMail

Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

I'm wanting the code to search in outlook for what is in cell E2 and post the received date in cell H2, then search in outlook for what is in cell E3 and post the received date in cell H3 and so on.
I thought I had it working for a while, but it now just posts in the first cell only (H2). Also the format seems all over the place.
Any help would be much appreciated.

A:

There is no loop to walk through the values in column E. Another For ... Next loop involving i should be sufficient.
Sub ReceivedEmailDate()
    Dim outlookApp
    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail As Variant
    Dim myTasks
    Dim sir() As String

    Set outlookApp = CreateObject("Outlook.Application")

    Set olNs = outlookApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    Set myTasks = Fldr.Items

    With ActiveSheet
        For i = 2 To .Cells(Rows.Count, "E").End(xlUp).Row
            For Each olMail In myTasks

                'This is where the search occurs in the outlook inbox (parameters can be altered depending on what you want to search for)
                'I have stated to search for the invoice numbers in the subject field of the email. Invoice numbers located down column E
                If CBool(InStr(1, olMail.Subject, .Cells(i, "E").Value, vbTextCompare)) Then
                    .Cells(i, "H") = CDate(olMail.ReceivedTime)   'put a real datetime in whether you need it right now or not
                    .Cells(i, "H").NumberFormat = "dd/mm/yy"      'format function to only show the date, rather than both date and time
                End If

            Next olMail
        Next i
    End With

    Set myTasks = Nothing
    Set Fldr = Nothing
    Set olNs = Nothing
    Set outlookApp = Nothing

End Sub

I've put a real datetime into column H and formatted it to dd/mm/yy. You can revert to the text representation of a date if you prefer.

