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]

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

Subject, received time, last modification time, etc. is imported from emails received between Date1 and Date2 (look at ProcessFolder) into the active sheet. Therefore a textbox is not really suitable for holding all this data. If you want the data to appear on your userform use an appropriate control like a listbox with multiple columns or a worksheet object.

The date input format shouldn't matter because CDate will convert it to your local date format, as long as the input value is a recognisable date.

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

means that olfdStart is no longer declared, so your code doesn't work.

 

[detolicious]

If i put this piece back in though, my userform won't be opened as I'll get the user-defined type not defined error message.

 

[John_w]

But changing that line like that to fix one error causes another error! I don't know why you are getting the user-defined type not defined error. Try typing in the whole line again (don't copy and paste it). Then click Debug - Compile VBAProject and fix any errors.

Here is my code adapted to work with your userform controls:

'Requires reference to Microsoft Outlook 11.0 Object Library

Option Explicit

Private Sub cmdImp_Click()

    Dim startDate As Date, endDate As Date
    Dim startRow As Long
    
    If Not IsDate(DateBox1.Value) Then
        MsgBox "Invalid Start Date: " & DateBox1.Value
        DateBox1.Value = ""
        DateBox1.SetFocus
        Exit Sub
    End If
    
    If Not IsDate(DateBox2.Value) Then
        MsgBox "Invalid End Date: " & DateBox2.Value
        DateBox2.Value = ""
        DateBox2.SetFocus
        Exit Sub
    End If
    
    'Convert input dates to Date variables and repopulate textboxes to show user the actual dates being used.
    'Include time in the end date to ensure emails received at any time on the end date are included
    
    startDate = CDate(DateBox1.Value)
    DateBox1.Value = Format(startDate, "dd/mm/yyyy")
    
    endDate = CDate(DateBox2.Value & " 23:59:59 PM")
    DateBox2.Value = Format(endDate, "dd/mm/yyyy")

    Cells.ClearContents
    startRow = 1
    
    Import_Outlook_Emails startDate, endDate, startRow
    
    MsgBox "Done"
    
End Sub


Private Sub Import_Outlook_Emails(startDate As Date, endDate As Date, row As Long)
     
    Dim OutlookOpened As Boolean
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
     
    'Get or create Outlook application object and make sure it exists before continuing
    
    On Error Resume Next
    OutlookOpened = False
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set olApp = New Outlook.Application
        OutlookOpened = True
    End If
    On Error GoTo 0
    
    If olApp Is Nothing Then
        MsgBox "Cannot start Outlook.", vbExclamation
        Exit Sub
    End If
     
    Set olNS = olApp.GetNamespace("MAPI")
    'Set olFolder = olNS.PickFolder
    Set olFolder = olNS.Folders("Personal Folders").Folders("Inbox")   'MODIFY FOR REQUIRED FOLDER
    
    Call ProcessFolder(olFolder, startDate, endDate, row)
    
    If OutlookOpened Then
        olApp.Quit
    End If
    
End Sub

Private Sub ProcessFolder(olfdStart As Outlook.MAPIFolder, startDate As Date, endDate As Date, row As Long)

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

All that code goes in the Userform1 module

 

[detolicious]

now this works like a charm - a thousand thanks!

I'll be having lot's of fun with this

 

[detolicious]

update: apparently this macro has no issue importing regular mails, but when I have something with a table it won't quite work. so i get all the regular mails but if i get stuff like sharepoint alerts it won't import it at all. not even if I remove parts of:

 Cells(row, 3) = olMail.ReceivedTime
                Cells(row, 4) = olMail.LastModificationTime
                Cells(row, 5) = olMail.Categories
                Cells(row, 6) = olMail.SenderName
                Cells(row, 7) = olMail.FlagRequest
                Cells(row, 8) = olMail.Body

It's like the alert is not a Outlook.MailItem but something else....

 

[detolicious]

I assume this (red) is the root of the issue (mail not being imported)

Microsoft Mail Internet Headers Version 2.0
X-MimeOLE: Produced By Microsoft Exchange V6.5
Content-class: [COLOR=red][B]Sharing
[/B][/COLOR]

regular mail (works fine)

Microsoft Mail Internet Headers Version 2.0
X-MimeOLE: Produced By Microsoft Exchange V6.5
Content-class: [COLOR=red][B]urn:content-classes:message
[/B][/COLOR]