Email to excel

[pratiksuhasaria]

Hi All

I want to import mails from my outlook inbox to excel sheet depending on subject line i.e. if and only if subject line contains text APPROVED or CLARIFICATION at the start of subject.

Subject : APPROVED xyzz.....
CLARIFICATION abc.....

only this type of mail need to be extracted from inbox.

I have following code in which I need some this changes:
Sub GetFromOutlook()


Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox)


i = 1
For Each OutlookMail In Folder.Items
With ThisWorkbook.Worksheets("TechnicalSheet").Range("B" & i + 1)
.NumberFormat = xlShortdate
.Value = DateValue(OutlookMail.ReceivedTime)
End With
ThisWorkbook.Worksheets("TechnicalSheet").Range("A" & i + 1).Value = OutlookMail.Subject
i = i + 1
Next OutlookMail
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing


End Sub

Please help me

 

[DanteAmor]

Try this

Sub GetFromOutlook()
  Dim OutlookApp As Outlook.Application, OutlookNamespace As Namespace
  Dim OutlookMail As Variant, i As Integer
  Set OutlookApp = New Outlook.Application
  Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
  i = 2
  For Each OutlookMail In OutlookNamespace.GetDefaultFolder(olFolderInbox).Items
    Select Case True
      Case UCase(OutlookMail.Subject) Like "*APPROVED*" Or UCase(OutlookMail.Subject) Like "*CLARIFICATION*"
        With ThisWorkbook.Worksheets("TechnicalSheet")
          .Range("A" & i).Value = OutlookMail.Subject
          .Range("B" & i).NumberFormat = xlShortdate
          .Range("B" & i).Value = DateValue(OutlookMail.ReceivedTime)
        End With
        i = i + 1
    End Select
  Next OutlookMail
  Set OutlookNamespace = Nothing
  Set OutlookApp = Nothing
End Sub