excel to access outlook mailbox and import mails

[detolicious]

Hi,

Can I get Excel to access Outlook and scan for mails with specific headers or from a specific sender and copy them?

I have a program that does a similar thing, I thought if I decompile it I could use some of its code but it may be a bit over-engineered for what I'm trying to do.

I know there are links to start Outlook and create an e-mail and so on, but can Excel scan for mails within Outlook?

Thanks,
D

 

[John_w]

The answer is yes. Search for MAPIFolder and MailItem. You could use the Restrict or Find methods to filter emails, or use your own If statements to find specific emails.

 

[detolicious]

ok here is what I did:

created new excel file "SkyHigh.xlsm"

Microsoft Excel Objects
_Sheet1 (SN)
_Sheet2 (EVALUATION)
_ThisWorkbook
Forms
_ SkyNetFrm
Modules
_Module1

The UserForm has a TextBox1 and TextBox2 (which I renamed to DateBox1 and DateBox2), also there are buttons 'Import'(Imp) and 'Process'(Proc)

Code in SkyNetFrm

Option Explicit
Dim n As Long
Private Sub cmdImp_Click()
     
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim Date1, Date2
     
    Do
        Date1 = DateBox1.Value
        If Date1 = False Then Exit Sub
        On Error Resume Next
        Date1 = CDate(Date1)
        On Error GoTo 0
    Loop Until IsDate(Date1)
    Do
        Date2 = DateBox2.Value
        If Date2 = False Then Exit Sub
        On Error Resume Next
        Date2 = CDate(Date2)
        On Error GoTo 0
    Loop Until IsDate(Date2)
     
    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.PickFolder
     
    n = 2
    Cells.ClearContents 'if there are start/end dates in any cell on this sheet this command will erase them
     
    Call ProcessFolder(olFolder, Date1, Date2)
     
    Set olNS = Nothing
    Set olFolder = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
End Sub
Private Sub cmdProc_Click(olfdStart As Outlook.MAPIFolder, Date1, Date2)
    Dim olFolder As Outlook.MAPIFolder
    Dim olObject As Object
    Dim olMail As Outlook.MailItem
    For Each olObject In olfdStart.Items
        If TypeName(olObject) = "MailItem" Then
            If olObject.ReceivedTime >= Date1 And olObject.ReceivedTime <= Date2 Then
                n = n + 1
                Set olMail = olObject
                Cells(n, 1) = olMail.Subject
                If Not olMail.UnRead Then Cells(n, 2) = "Message is read" Else Cells(n, 2) = "Message is unread"
                Cells(n, 3) = olMail.ReceivedTime
                Cells(n, 4) = olMail.LastModificationTime
                Cells(n, 5) = olMail.Categories
                Cells(n, 6) = olMail.SenderName
                Cells(n, 7) = olMail.FlagRequest
            End If
        End If
    Next
    Set olMail = Nothing
    Set olFolder = Nothing
    Set olObject = Nothing
End Sub

Code in Module 1

Sub Sky()
SkyNetFrm.Show
End Sub

I get an error though saying: "Compile error: User-defined type not defined" - no debug button, nothing

I assume it has to do with the dates...

 

[John_w]

Have you set a reference to the Outlook Object library? In the VB Editor, Tools - References - tick MS Outlook 11.0 (or 12.0 for Outlook 2007) Object library.

 

[detolicious]

Yep, actually thats ticked

 

[John_w]

Ignoring the userform objects, which I haven't bothered with, your code doesn't compile for me. Try changing:

Private Sub cmdProc_Click(olfdStart As Outlook.MAPIFolder, Date1, Date2)

to:

Private Sub ProcessFolder(olfdStart As Outlook.MAPIFolder, Date1, Date2)

 

[detolicious]

that sets off the same error message, I wonder if it is because I put it into a userform :/

 

[detolicious]

I scrapped the above code - it's not really working. instead i use:

Private Sub cmdImp_Click()
   Dim olApp As Object
   Dim olNS As Object
   Dim olFolder As Object
   Dim olAnswer As Object, olMsg As Object
   Dim myName As Object
   Dim Column As String
   Dim intLastRow As Integer
   
   Set olApp = CreateObject("Outlook.Application")
   Set olNS = olApp.GetNamespace("MAPI")
   Set olFolder = olNS.Folders("Mailbox - XXXXX XXXX XXXX [XXXXXX]") _
      .Folders("Inbox")
   Set olMsg = olFolder.items(olFolder.items.Count)
   Worksheets("EVALUATION").Activate
   Column = "A"
   intLastRow = Cells(Cells.Rows.Count, Column).End(xlUp)
   If intLastRow < 1 Then intLastRow = 1
   Value = Cells(intLastRow, Column).Address(False, False)
   Range(Value) = olMsg.Body
   Set olAnswer = Nothing
   Set olMsg = Nothing
   Set olFolder = Nothing
   Set olNS = Nothing
   Set olApp = Nothing
End Sub

this obviously accesses a pre-defined sheet in my excel. Even better though if it would put all data into 'OutBox1' on my UserForm. Furthermore I'd like to add not only the text of the mail, but much rather Date and Time received and the Subject.

 

[John_w]

Going back to your original code, this works for me:

Option Explicit

Dim n As Long

Sub Get_Emails()
     
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim Date1, Date2
     
    Do
        Date1 = InputBox("Start date")
        If Date1 = "" Then Exit Sub
        On Error Resume Next
        Date1 = CDate(Date1)
        On Error GoTo 0
    Loop Until IsDate(Date1)
    
    Do
        Date2 = InputBox("End date")
        If Date2 = "" Then Exit Sub
        On Error Resume Next
        Date2 = CDate(Date2)
        On Error GoTo 0
    Loop Until IsDate(Date2)
     
    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.PickFolder
     
    n = 2
    Cells.ClearContents 'if there are start/end dates in any cell on this sheet this command will erase them
     
    Call ProcessFolder(olFolder, Date1, Date2)
     
    Set olNS = Nothing
    Set olFolder = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
End Sub

Private Sub ProcessFolder(olfdStart As Outlook.MAPIFolder, Date1, Date2)
    Dim olFolder As Outlook.MAPIFolder
    Dim olObject As Object
    Dim olMail As Outlook.MailItem
    For Each olObject In olfdStart.Items
        If TypeName(olObject) = "MailItem" Then
            If olObject.ReceivedTime >= Date1 And olObject.ReceivedTime <= Date2 Then
                n = n + 1
                Set olMail = olObject
                Cells(n, 1) = olMail.Subject
                If Not olMail.UnRead Then Cells(n, 2) = "Message is read" Else Cells(n, 2) = "Message is unread"
                Cells(n, 3) = olMail.ReceivedTime
                Cells(n, 4) = olMail.LastModificationTime
                Cells(n, 5) = olMail.Categories
                Cells(n, 6) = olMail.SenderName
                Cells(n, 7) = olMail.FlagRequest
            End If
        End If
    Next
    Set olMail = Nothing
    Set olFolder = Nothing
    Set olObject = Nothing
End Sub

It gets the dates using InputBox statements instead of userform textboxes, so you just have to change those lines if you want to use your userform values.

 

[detolicious]

right, so i tried this one again but had to change some things to open the userform as this user-defined type error showed up

Option Explicit
Dim n As Long
Private Sub cmdImp_Click()
     
    Dim olApp As Object
    Dim olNS As Object
    Dim olFolder As Object
    Dim Date1, Date2
     
    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.Folders("Mailbox - specific") _
        .Folders("Inbox")
    Set Date1 = DateBox1
    Set Date2 = DateBox2
     
     
    Do
        Date1 = DateBox1
        If Date1 = "" Then Exit Sub
        On Error Resume Next
        Date1 = CDate(Date1)
        On Error GoTo 0
    Loop Until IsDate(Date1)
    
    Do
        Date2 = DateBox2
        If Date2 = "" Then Exit Sub
        On Error Resume Next
        Date2 = CDate(Date2)
        On Error GoTo 0
    Loop Until IsDate(Date2)
     
     
    n = 2
     
    Call ProcessFolder '(olFolder, Date1, Date2)
     
    Set olNS = Nothing
    Set olFolder = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
End Sub
Private Sub ProcessFolder() '(olfdStart As Outlook.MAPIFolder, Date1, Date2)
    Dim olFolder As Outlook.MAPIFolder
    Dim olObject As Object
    Dim olMail As Outlook.MailItem
    For Each olObject In olfdStart.Items
        If TypeName(olObject) = "MailItem" Then
            If olObject.ReceivedTime >= Date1 And olObject.ReceivedTime <= Date2 Then
                n = n + 1
                Set olMail = olObject
                Cells(n, 1) = olMail.Subject
                If Not olMail.UnRead Then Cells(n, 2) = "Message is read" Else Cells(n, 2) = "Message is unread"
                Cells(n, 3) = olMail.ReceivedTime
                Cells(n, 4) = olMail.LastModificationTime
                Cells(n, 5) = olMail.Categories
                Cells(n, 6) = olMail.SenderName
                Cells(n, 7) = olMail.FlagRequest
            End If
        End If
    Next
    Set olMail = Nothing
    Set olFolder = Nothing
    Set olObject = Nothing
End Sub

my question is... what from the mail is imported and where? preferably i would want to have it all in 'OutBox1' which is a textbox in the userform

furthermore, does the date format matter? When I tried to execute my excel just crashed