VBA: Copy mail from shared outlook mailbox to excel

[Kruijf]

Hi all,

I have question, im looking for a macro that copies mail from a shared mailbox to excel. I do understand a little bit of VBA but im not good with writing my own macro's (yet). On the internet i found a macro that copies mail from specific folder in my default mail account, but that one does not work with shared mailboxes.

We need mails from specific folders in outlook in Excel so we can use the data for some reports that we make daily. Because it takes a while to copy those mails we would like to automate this with a macro. I did search on the internet but on a few occasions i found that people noted that it was not possible. We're using Office 2013.

So my questions are.
- Is it possible to do this with VBA?
- If so, does anybody have a macro that i can use for my situation?


I hope it's clear what we need, hopefully it's possible and somebody can send me in the right direction.
Thanks in advance.

Kind regards,
Tom

 

[Kruijf]

Hi,

No problem, probably my knowledge of VBA is limited. I Already learned a few things through this thread.

But im still getting the same results.
What i did:
From excel i opened the VBA Editor (Alt+F11), pushed the play button to run the code, then i get the same result. The code is placed in a module and no other macro's in it. I also tried it with my own mailbox and just the code for checking the inbox. I placed ' before the line of code, this should make it a comment i believe.

IS it something that am i doing wrong?

Thanks for your help and patience.

 

[RickXL]

OK, let's re-group.

When you are in the VB Editor can you see a Window labelled "Immediate"?

It should look something like this on at the bottom right of the picture:

If that is not visible, go to the View menu and select Immediate Window (Ctrl + G will do the same).

Now run this code:

Sub Test()
    Debug.Print "This is a debug message."
End Sub

Make sure the cursor is in the code then hit F5 to run it. You should see the message "This is a debug message." displayed in the Immediate Window.

Tell me what happens and we will progress from there.

I find it encouraging that your Outlook macros do not give an error when the code runs. This would indicate that it likes the folder names. Also, the pause when looking at the secondary Inbox sounds promising. It always seems to take some time to read a stack of emails.

 

[Kruijf]

Hi,

I knew it was something that was missing from my side. But i activated the window and all the results of the code was showing, its working!

I tried the code earlier with different folders and each folder that i have tested it shows the number of emails.

 

[RickXL]

Good news!!

Now you need to decide which fields you want to extract and where to put them and we can finish the macro.

 

[Kruijf]

Yes it is!

The columns that we need are:
- From
- Subject
- Received
- Categories
- Flag Completed Date
- Name of outlook folder where the mail comes from (if possible)

The last column is optional, but this code will be used in multiple reports where some of them we need to know which folder they came from. This is because through those folder names we know what kind of mail it was, for some of those reports we need to know that.

Again, thanks for your help.

 

[RickXL]

Hi,

Try this. It uses Sheet1 to display the results and beware, it clears it first.

' Requires Tools-->References-->Microsoft Outlook 15.0 Object Library
Sub getEmails()

    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFldr As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olMailItem As Outlook.MailItem
    Dim ws As Worksheet
    Dim iRow As Long
    Dim hdr As Variant
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    
    Set olFldr = olNS.Folders(1)
    Set olFldr = olFldr.Folders("Inbox")
    Set olFldr = olFldr.Folders("MrExcel")
    Set olFldr = olFldr.Folders("Keep")
    
    ws.Cells.Clear
    iRow = 2
    
    Application.ScreenUpdating = False
    For Each olItem In olFldr.Items
        If olItem.Class = olMail Then
            Set olMailItem = olItem
            With olMailItem
                ws.Cells(iRow, "A") = .Sender
                ws.Cells(iRow, "B") = .SenderEmailAddress
                ws.Cells(iRow, "C") = .SenderName
                ws.Cells(iRow, "D") = .Subject
                ws.Cells(iRow, "E") = .ReceivedTime
                ws.Cells(iRow, "F") = .Categories
                ws.Cells(iRow, "G") = .TaskCompletedDate
                ws.Cells(iRow, "H") = olFldr.Name
                iRow = iRow + 1
            End With
        End If
    Next olItem

    With ws
        hdr = Array("Sender", "SenderEmailAddress", "SenderName", "Subject", "ReceicedTime", "Categories", "TaskCompletedDate", "Folder")
        .Range("A1").Resize(, UBound(hdr)) = hdr
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = False
End Sub

 

[Kruijf]

Hi,

The code works, so i will play arround with it in our reports to see if this is what we can use, will let you know the results.

Thanks for your help!

 

[RickXL]

OK, thanks for letting me know.

I look forward to the next update.

Regards,

 

[Kruijf]

Hi,

I tested the code and it works nice I have just a few questions.
- Is it possible to change that instead of always copying it to a specific cell that it will select the first empty row in a table? Some reports it needs to over right the data and some reports it needs to be in the first empty row. It does not matter if the headers of the columns will be placed in the data too. Because in most cases we remove duplicates so this wouldnt be a problem.
- For one of our customers we have more then one outlook folder, is there a easy way to get this in the code too?

Is this easy to change?

Thanks for your help.

 

[RickXL]

Hi,

Appending rows should be quite easy. I have removed the Clear statement so the output sheet will need to be empty the first time it is used. If have left the heading line unchanged but it will only appear in row 1 anyway. It will just over write itself.

' Requires Tools-->References-->Microsoft Outlook 15.0 Object Library
Sub getEmails()

    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFldr As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olMailItem As Outlook.MailItem
    Dim ws As Worksheet
    Dim iRow As Long
    Dim hdr As Variant
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    
    Set olFldr = olNS.Folders(1)
    Set olFldr = olFldr.Folders("Inbox")
    Set olFldr = olFldr.Folders("MrExcel")
    Set olFldr = olFldr.Folders("Keep")
    
    With ws
        iRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    Application.ScreenUpdating = False
    For Each olItem In olFldr.Items
        If olItem.Class = olMail Then
            Set olMailItem = olItem
            With olMailItem
                iRow = iRow + 1
                ws.Cells(iRow, "A") = .Sender
                ws.Cells(iRow, "B") = .SenderEmailAddress
                ws.Cells(iRow, "C") = .SenderName
                ws.Cells(iRow, "D") = .Subject
                ws.Cells(iRow, "E") = .ReceivedTime
                ws.Cells(iRow, "F") = .Categories
                ws.Cells(iRow, "G") = .TaskCompletedDate
                ws.Cells(iRow, "H") = olFldr.Name
            End With
        End If
    Next olItem

    With ws
        hdr = Array("Sender", "SenderEmailAddress", "SenderName", "Subject", "ReceivedTime", "Categories", "TaskCompletedDate", "Folder")
        .Range("A1").Resize(, UBound(hdr)) = hdr
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = False
End Sub

How would you want to supply the list of folders to be changed? Would it be fixed? Excel has the folders in hierarchies so you have to start at the top and navigate down. This gets round the problem of having several folders all called, say, Save. By navigating down the hierarchy you ensure that you are looking at the right one. So looping through a list of folders is not as easy as just entering the list, you need to navigate the hierarchies as well.