Excel VBA to get an email received time by reading Subject line from the excel column

[Abhijit29]

Hello Team,

I have created a VBA script, to get an email received time from the subject title mentioned in the excel column.

The Excel will look like,


And, the Script is as below

Option Explicit

Sub Test()

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Object
Dim i As Integer, j As Integer


Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("DSD")

i = 1
For Each olMail In Fldr.Items
    If Range("C" & i).Value <> "" Then
    'MsgBox (Range("C" & i).Value)
        If olMail.Subject = Range("C" & i).Value Then
            'Range("A" & i).Value = olMail.Subject ' <-- output email name to column A
            Range("B" & i).Value = olMail.ReceivedTime ' <-- output email sent date to column B
            'olMail.Display ' show email through Excel
            i = i + 1
        End If
    End If
Next olMail

End Sub

Issue : When the script starts with Cell C1(which is a column title), it didn't find the matching subject in outlook so instead of going to the next cell the script ends directly.

If you guys can help me to sort this issue, the script should not end it should go to the next cell if didn't find the value specified in the cell.

Please note the script is going to the next cell if it finds the value in outlook and even we get the exact dates as well.

MOD EDIT: Added Code tags!

 

[Kenneth Hobson]

If you are matching to cells to Outlook subject, you need to iterate both. The more efficient method is to use Range's Find. e.g.

Sub FindInRange()
  Dim r As Range, f As Range, v As Long
  
  v = 22
  Set r = Range("C2", Cells(Rows.Count, "C").End(xlUp))
  Set f = r.Find(v, r.Cells(r.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False)
  If Not f Is Nothing Then MsgBox f.Row
End Sub

 

[Abhijit29]

Hello Kenneth,

Thank you for your suggestion.

it did work and it is going to the next cell, but the problem is if the value found for cell C3, it put the received time value in cell B1 instead of B3.

Excel will look like now,


and the code looks like now,

Option Explicit

Sub Test()

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Object
Dim i As Integer, j As Integer
Dim r As Range, f As Range, v As Long

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("DSD")


i = 1
For Each olMail In Fldr.Items
      Set r = Range("C2", Cells(Rows.Count, "C").End(xlUp))
      Set f = r.Find(olMail.Subject, r.Cells(r.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False)
        If Not f Is Nothing Then
            'Range("A" & i).Value = olMail.Subject ' <-- output email name to column A
            Range("B" & i).Value = olMail.ReceivedTime ' <-- output email sent date to column B
            olMail.Display ' show email through Excel
            i = i + 1
        End If

Next olMail

End Sub

Could you please help me with it, the date should be on the next to matching subject.

I am new to the VBA, I tried from my side

 

[Kenneth Hobson]

You missed the f.row part. The i counter was not needed.

Sub Main()
  Dim olApp As Outlook.Application, olNs As Namespace, Fldr As MAPIFolder
  Dim olMail As Object, i As Long, j As Integer
  Dim r As Range, f As Range, v As Long
  
  Set olApp = New Outlook.Application
  Set olNs = olApp.GetNamespace("MAPI")
  Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("DSD")
  
  For Each olMail In Fldr.Items
    Set r = Range("C2", Cells(Rows.Count, "C").End(xlUp))
    Set f = r.Find(olMail.Subject, r.Cells(r.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False)
      If Not f Is Nothing Then
        i = f.Row
        'Range("A" & i).Value = olMail.Subject ' <-- output email name to column A
        Range("B" & i).Value = olMail.ReceivedTime ' <-- output email sent date to column B
        olMail.Display ' show email through Excel
      End If
  Next olMail
End Sub

 

[Abhijit29]

Thank you, Kenneth.

That worked for me . Thank you so much again now I don't need to maintain the record manually.

 

[grp]

Thank you, Kenneth.

That worked for me . Thank you so much again now I don't need to maintain the record manually.

call you please tell me full process, I also want to connect excel and outlook like you. please provide step by step instructions.

Thank you in advance