Results 1 to 10 of 10

Thread: Accessing a shared inbox from outlook to VBA

  1. #1
    New Member
    Join Date
    Oct 2019
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Accessing a shared inbox from outlook to VBA

    Hello,

    I have written some code that retrieves the number of mails from two inboxes. I've tested it locally however when I am trying to connect to a Shared Inbox, it returns a 0. I am very confused and I am wondering if someone can help me.
    The names of the two shared inboxes are 1) FolderA and 2) FolderB. Both have some folders and subfolders in the following combination:
    Shared inbox Folder Subfolder
    [FolderA, Values]
    [FolderA, Margins, PastMargins]
    [FolderA, Lesbeque, Research]
    [FolderB, Internal Commitments, Attached]
    [FolderB, Extern Commitments, New]
    Those routes leads to the desired mailbox where I try to extract the count.

    Code:
    Sub GetFromOutlook()
        Dim folderlist1, folderlist2 As Variant
        Dim num_of_folders As Variant
        Dim accounts As Variant
        Dim accname As String
        Dim count As Integer
        Dim sheetName As String
        
        sheetName = "Import"
        accounts = Array("FolderA", "FolderB") ' account name should be here
        num_of_folders = Array(3, 2)
        folderlist1 = Array("Values", "Margins", "Lesbeque", "Intern", "Extern") ' folders list
        folderlist2 = Array("NULL", "PastMargins", "Research", "Attached", "New") ' sub folders like test02 in WS1, if there is no sub folder write NULL
        lastRow = Worksheets(sheetName).Cells(Rows.count, 1).End(xlUp).Row
        colIndex = 1
        folder_index = LBound(folderlist1)
        
        For kk = LBound(accounts) To UBound(accounts)
            accname = accounts(kk)
            For ii = folder_index To (folder_index + num_of_folders(kk) - 1)
                If folderlist2(ii) = "NULL" Then
                    count = GetFolderCount(accname, folderlist1(ii))
                Else
                    count = GetSubFolderCount(accname, folderlist1(ii), folderlist2(ii))
                End If
                Worksheets(sheetName).Cells(lastRow + 1, colIndex).Value = count
                colIndex = colIndex + 1
            Next ii
            folder_index = folder_index + num_of_folders(kk)
        Next kk
    End Sub
    
    
    Function GetFolderCount(ByVal accname As String, ByVal folder1 As String)
        Dim OutlookApp As Outlook.Application
        Dim oaccount As Outlook.Account
        Dim ostore As Outlook.store
        Dim OutlookNamespace As Namespace
        Dim Folder As MAPIFolder
        Dim OutlookMail As Variant
        Dim i As Integer
        Dim myNameSpace As Outlook.Namespace
        Dim sheetName As String
        
        sheetName = "Import"
        Set OutlookApp = New Outlook.Application
        
        For Each oaccount In OutlookApp.Session.accounts
            If oaccount = accname Then
                Set ostore = oaccount.DeliveryStore
                Set Folder = ostore.GetDefaultFolder(olFolderInbox).folders(folder1)
                i = 0 'Folder.ShowItemCount
                For Each OutlookMail In Folder.Items
                    If TypeOf OutlookMail Is MailItem Then
                            i = i + 1
                    End If
                Next OutlookMail
                
                Set Folder = Nothing
                Set OutlookNamespace = Nothing
                Set OutlookApp = Nothing
            End If
    
    
        Next oaccount
        
        GetFolderCount = i
    
    
    End Function
    
    
    Function GetSubFolderCount(ByVal accname As String, ByVal folder1 As String, ByVal folder2 As String)
        Dim OutlookApp As Outlook.Application
        Dim oaccount As Outlook.Account
        Dim ostore As Outlook.store
        Dim OutlookNamespace As Namespace
        Dim Folder As MAPIFolder
        Dim OutlookMail As Variant
        Dim i As Integer
        Dim myNameSpace As Outlook.Namespace
        Dim sheetName As String
        
        sheetName = "Import"
        Set OutlookApp = New Outlook.Application
        
        For Each oaccount In OutlookApp.Session.accounts
            If oaccount = accname Then
                Set ostore = oaccount.DeliveryStore
                Set Folder = ostore.GetDefaultFolder(olFolderInbox).folders(folder1).folders(folder2)
                i = 0 'Folder.ShowItemCount
                For Each OutlookMail In Folder.Items
                    If TypeOf OutlookMail Is MailItem Then
                            i = i + 1
                    End If
                Next OutlookMail
                
                Set Folder = Nothing
                Set OutlookNamespace = Nothing
                Set OutlookApp = Nothing
            End If
            'ostore = Nothing
        Next oaccount
        
        GetSubFolderCount = i
    
    End Function
    I am very much wondering is someone can help me!
    Last edited by Fluff; Nov 3rd, 2019 at 08:58 AM.

  2. #2
    New Member
    Join Date
    Oct 2019
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Accessing a shared inbox from outlook to VBA

    So these are the shared inboxes:
    Code:
    accounts = Array("FolderA","FolderB")
    The code above only works when you put @outlook.com or something else behind it.. However the shared inboxes have none like that.
    Last edited by Fluff; Nov 3rd, 2019 at 08:59 AM.

  3. #3
    New Member
    Join Date
    Oct 2019
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Accessing a shared inbox from outlook to VBA

    So with some searching on the internet; they use the GetSharedDefaultFolder function. However they use it to return an calendar and not a inbox or multiple inboxes. Please help!

  4. #4
    Board Regular Taul's Avatar
    Join Date
    Oct 2004
    Location
    Uxbridge
    Posts
    644
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Accessing a shared inbox from outlook to VBA

    Hi,
    I'm not sure if this will help but below is a code I use to pull emails from a shared account. You may be able to adapt it to suit your needs.
    there are bits of code in it that you may be looking for.
    cheers
    Paul.



    Code:
    Sub GetFromOutlook()
    
    
    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Integer
    Dim olNS As Outlook.Namespace
    
    
    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    
    
    '**** this bit is added to get a shared email ******
        Set objOwner = OutlookNamespace.CreateRecipient("training@company.com")
        objOwner.Resolve
    
    
        If objOwner.Resolved Then
            Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox) 'can use olFolderInbox or olFolderSentMail
        End If
    '*****************************************************
    'or use this approach
    'Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Net Sales Report").Folders("Sales")
            'Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox)' use Inbox or SentMail, not both
            'Set Folder = OutlookNamespace.GetDefaultFolder(olFolderSentMail)
    
    
    '        'Get the appointments from Outlook
    '        Set olkLst = olkFld.Items
    '        olkLst.Sort "[Start]"
    '        olkLst.IncludeRecurrences = True ' this is for calendar items
    '        Set olkRes = olkLst.Restrict("[Start] >= '" & Format(datBeg, "ddddd h:nn AMPM") & "' AND [Start] <= '" & Format(datEnd, "ddddd h:nn AMPM") & "'")
    '        'Write appointments to spreadsheet
    '        For Each olkApt In olkRes
    'Set olkRes = olkLst.Restrict("[Start] >= '" & Format(datBeg, "ddddd h:nn AMPM") & "' AND [Start] <= '" & Format(datEnd, "ddddd h:nn AMPM") & "'")
    '******************************************************
    
    
    'Write mail to spreadsheet - create named range, from and to dates on the spreadsheet
    i = 1
    For Each OutlookMail In Folder.Items
        'If OutlookMail.ReceivedTime >= Range("From_date").Value Then
        If OutlookMail.ReceivedTime >= Range("From_date").Value And OutlookMail.ReceivedTime <= Range("To_date").Value Then
            Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
            Range("eMail_sender").Offset(i, 0).Value = OutlookMail.SenderName
            Range("eMail_recipient").Offset(i, 0).Value = OutlookMail.To
            Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
            Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body
            Range("eMail_cc").Offset(i, 0).Value = (OutlookMail.CC)
            Range("eMail_bcc").Offset(i, 0).Value = (OutlookMail.BCC)
            i = i + 1
        End If
    Next OutlookMail
    
    
    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
    
    
    End Sub
    Excel 2010 on Win7 at home - 2013 on win7 at work

  5. #5
    Board Regular Taul's Avatar
    Join Date
    Oct 2004
    Location
    Uxbridge
    Posts
    644
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Accessing a shared inbox from outlook to VBA

    Excel 2010 on Win7 at home - 2013 on win7 at work

  6. #6
    New Member
    Join Date
    Oct 2019
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Accessing a shared inbox from outlook to VBA

    Hey Taul, thank you very much. I have a folder in the inbox, it's called Values and there in a subfolder called 2019. I have managed to get the whole inbox in it but not able to get the subfolders.

    How can I extend the line
    Code:
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox)
    To Subfolder in inbox "Values" and then subfolder called "2019"?
    Last edited by Lehman; Oct 26th, 2019 at 02:36 AM.

  7. #7
    Board Regular Taul's Avatar
    Join Date
    Oct 2004
    Location
    Uxbridge
    Posts
    644
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Accessing a shared inbox from outlook to VBA

    Hi,
    Quote:- "I have a folder in the inbox, it's called Values and there in a subfolder called 2019"

    I cant test this but try

    Change this:-
    Code:
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox)
    to this:-
    Code:
    Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Values").Folders("2019")
    Excel 2010 on Win7 at home - 2013 on win7 at work

  8. #8
    Board Regular Taul's Avatar
    Join Date
    Oct 2004
    Location
    Uxbridge
    Posts
    644
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Accessing a shared inbox from outlook to VBA

    Opps!, I forgot to include the shared bit,
    change it to:-

    Code:
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(olFolderInbox).Folders("Values").Folders("2019")
    


    Excel 2010 on Win7 at home - 2013 on win7 at work

  9. #9
    New Member
    Join Date
    Oct 2019
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Accessing a shared inbox from outlook to VBA

    Hey Taul, yes your solutions are working! However now I have another problem; wondering if you can help me with that.
    When I use two different shared mailboxes, I get an registry error. I have asked the question here: https://www.mrexcel.com/forum/excel-...same-time.html

    Can you perhaps help me with that? Ill be you forever grateful!

  10. #10
    Board Regular Taul's Avatar
    Join Date
    Oct 2004
    Location
    Uxbridge
    Posts
    644
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Accessing a shared inbox from outlook to VBA

    Hi Lehman,
    Good to hear the code is working.
    Iíve never tried to pull from two or more different email accounts at the same time, so Iím not sure how to do that.
    Iím guessing you may need to make two separate connections to Outlook, so as one code (your working code) finishes, you repeat the action for the next email account.
    There is probably a smarter way to achieve this by cresting a loop but you will have to either experiment with it or wait for someone else to reply.
    Excel 2010 on Win7 at home - 2013 on win7 at work

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •