简体   繁体   中英

Creating folders in shared mailbox via Excel VBA

I'm using the below code I've found to create email folders in Outlook from a list in Excel. I can get it working fine from my default email account but I'm struggling to implement it for a shared mailbox.

I've added code to return the account number (as xref) associated with a specified email address. How can I amend the 'Add folders' section to utilise this information (and will I need code to 'reset' the account back to the user's default?).

I will then also need to know how to move an existing folder to another folder (eg from 'DEV TEST' to 'DEV TEST/ARCHIVE').

Thanks.

Sub CreateEmailFol()

Dim admin As Worksheet

Set admin = ThisWorkbook.Worksheets("Admin")

Const olFolderInbox As Long = 6
Dim OutlApp As Object
Dim a(), x
Dim IsCreated As Boolean

Dim OutApp As Outlook.Application
Dim i As Long

    ' Get account number for email address
    Set OutApp = CreateObject("Outlook.Application")

    For i = 1 To OutApp.Session.Accounts.Count
        If OutApp.Session.Accounts.Item(i) = "x@x.com" Then xref = i
    Next i

    ' Copy folder names into array to speed up the code
    With admin
        If .FilterMode Then .ShowAllData
        a = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Offset(1, 0).Value
        If Not IsArray(a) Then x = a: ReDim a(1 To 1): a(1) = x
    End With

    ' Use already open Outlook application if possible
    On Error Resume Next
    Set OutlApp = GetObject(, "Outlook.Application")
    If Err Then
        Set OutlApp = CreateObject("Outlook.Application")
        IsCreated = True
    End If

    ' Add folders
    With OutlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("DEV TEST")
        For Each x In a
        .Folders.Add x
        Next
    End With

    ' Release the memory of object variable
    Set OutlApp = Nothing
    Set OutApp = Nothing

End Sub

You need to call NameSpace.GetSharedDefaultFolder to get access to a user's shared Inbox. However, you won't have access to any other mail folder (eg sub-folders under Inbox) unless that user grants you Full Mailbox permissions and you add that Mailbox as an additional account in your Outlook profile (which you can then access via the Stores collection).

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM