Count Emails in Outlook and export to excel

[bmeye4]

I am trying to count the amount of emails, in real time, in a subfolder in Outlook 2013 and automatically export the data to excel. I don't mind opening the excel document and refreshing the data daily, if needed.
The subfolder is called "disks" - it is in a group mailbox subfolder. Any ideas?

 

[DanteAmor]

I really do not know where your folder is, but try this

Sub GetEmail_1()
'Fuente: http://stackoverflow.com/questions/8322432/using-visual-basic-to-access-subfolder-in-inbox
'fuente: http://www.snb-vba.eu/VBA_Outlook_external_en.html
'fuente: https://support.microsoft.com/en-us/kb/208520
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim msg As Outlook.MailItem
    '
    Application.ScreenUpdating = False
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    '
    Set olFolder = objNS.Folders("[B][COLOR=#ff0000]disks[/COLOR][/B]")
    Set MyItems = olFolder.Items
    i = 2
    Columns("B:C").Clear
    NumItems = olFolder.Items.Count
    f = 1
    On Error Resume Next
    For n = 1 To NumItems
        Cells(f, "A") = MyItems(n).SenderName
        Cells(f, "B") = MyItems(n).Subject
        Cells(f, "C") = MyItems(n).body
        f = f + 1
    Next
    Columns("B:C").WrapText = False
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

-------
or if your subfolder is inside another folder, for example a backup, try this

Sub GetEmail_2()
'Fuente: http://stackoverflow.com/questions/8322432/using-visual-basic-to-access-subfolder-in-inbox
'fuente: http://www.snb-vba.eu/VBA_Outlook_external_en.html
'fuente: https://support.microsoft.com/en-us/kb/208520
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim msg As Outlook.MailItem
    '
    Application.ScreenUpdating = False
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    '
    Set olFolder = objNS.Folders("[B][COLOR=#ff0000]Backup[/COLOR][/B]")
    Set subfolder = olFolder.Folders("[B][COLOR=#ff0000]disks[/COLOR][/B]")
    Set MyItems = subfolder.Items
    i = 2
    Columns("A:C").Clear
    NumItems = subfolder.Items.Count
    f = 1
    On Error Resume Next
    For n = 1 To NumItems
        Cells(f, "A") = MyItems(n).SenderName
        Cells(f, "B") = MyItems(n).Subject
        Cells(f, "C") = MyItems(n).body
        f = f + 1
    Next
    Columns("B:C").WrapText = False
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

 

[bmeye4]

Thank You!!! Slightly different than mine so it should work

 

[DanteAmor]

Try and tell me

 

[bmeye4]

Yep! It worked. Thank you.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[JACOBB9900]

DanteAmor,

Is there a to automate the code so it is constantly pulling from Outlook?

Thank you.

 

[DanteAmor]

DanteAmor,

Is there a to automate the code so it is constantly pulling from Outlook?

Thank you.

How automatic do you need it?
It may be when you open your file, then put the macro in the Open event of your file.

 

[JACOBB9900]

I'd like for the macro to pull from Outlook a few times a day if possible.

 

[DanteAmor]

That would be my recommendation. Run the macro. Or put it in the open event.
There is the alternative of putting a macro that is "latent" and runs every time interval, but I do not recommend it. But if you want to, then inquire about the Application.Ontime method.