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.