none
Extracting sender details from all types in Inbox RRS feed

  • Question

  • Hi All

    I am trying to create a simple loop through my inbox that will extract the sender's email address and time of sending and create a new excel sheet (saved into my documents) and paste the details in there, save and move the processed e-mails into a folder named processed.

    I am okay with excel's VBA but outlook is a different kettle of fish and am struggling, It seems to be snagging on the mail type (I didn't know there were different types) the code below works fine but misses almost half of all the messages I have tried several options to no avail. Any help would be greatly appreciated

    Option Explicit

    Sub extractFromInbox()

    Dim objNS As Outlook.NameSpace
    Set objNS = Application.GetNamespace("MAPI")

    Dim olFolder As Outlook.MAPIFolder
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)

    Dim Item As Object
    Dim oMail As Outlook.MailItem

    Dim strFolderpath As String
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)

    Dim counter As Long
    counter = 0

    Dim path As String
    path = strFolderpath & "\recieved emails " & CStr(Format(Now, "dd_mm_yyyy_hh_mm_ss")) & ".xlsx"

    Dim destFolder As Outlook.MAPIFolder
    Set destFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Processed")

    Dim xlApp As Object
    Dim wbk As Object

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Application.Visible = True
    Set wbk = xlApp.Workbooks.Add
    wbk.SaveAs path
      
    On Error Resume Next

    For Each Item In olFolder.Items
        
        If TypeName(Item) = "MailItem" Then
            Set oMail = Item
            wbk.worksheets(1).Range("A1").Offset(counter, 0) = Item.SenderEmailAddress
            wbk.worksheets(1).Range("A1").Offset(counter, 1) = oMail.ReceivedTime
            oMail.Move destFolder
            counter = counter + 1
        End If
        
    Next

    On Error GoTo 0:

    wbk.Save
    wbk.Close

    End Sub

    Wednesday, October 22, 2014 1:28 PM

All replies