Myself and a colleague both have access to a shared outlook account we'll call "mailbot", I'm writing a VBA macro that scans for emails in the main inbox, extracts information, and uses that to populate an excel sheet.
The following code executes this perfectly on my computer
Sub Account_Change()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.Namespace
Dim sharedmailbox As Outlook.Recipient
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI") 'Object that can access folders/storage
objectNS.Logon
Set sharedmailbox = objectNS.CreateRecipient("[email protected]")
sharedmailbox.Resolve
If sharedmailbox.Resolved Then
Set objFolder = objectNS.GetSharedDefaultFolder(sharedmailbox, olFolderInbox)
For Each Item In objFolder.Items
If TypeOf Item Is Outlook.MailItem Then
Dim oMail As Outlook.MailItem: Set oMail = Item
body_str = CStr(oMail.Body)
End If
Next
End If
However on my colleagues pc he gets the error
Run-time error '-2147221219 (8004011d)': The operation failed because of a registry or installation problem, restart outlook and try again. If the problem persists reinstall
This highlights the line
Set objFolder = objectNS.GetSharedDefaultFolder(sharedmailbox, olFolderInbox)
As being the one causing the error, and restarting outlook does not cause any difference. I added the logon line after checking microsofts documentation on how to setup shared access but this did not fix the issue. Has anyone had experience with this before/know how to fix?
In a comment the OP indicated
"This has worked, I had already formatted the resolve the way you note here and it was not working, it seems the labelling of session.getshareddefaultfolder was the solution.".
My point remains Resolve is for names not addresses.
https://learn.microsoft.com/en-us/office/vba/api/outlook.recipient.resolve
https://learn.microsoft.com/en-us/office/vba/api/outlook.recipients.resolveall
This frequently asked question is usually due to
If sharedmailbox.Resolved Then
always being True when an address is used in
Set sharedmailbox = Session.CreateRecipient("[email protected]")
This demonstrates how to apply Resolve.
Option Explicit
Sub Account_Change()
Dim sharedMailbox As Recipient
Dim objFolder As Folder
Dim objItem As Object
Dim objMail As MailItem
Dim body_str As String
'Set sharedmailbox = Session.CreateRecipient("[email protected]")
Dim mailboxName As String
mailboxName = "mailbox name"
Set sharedMailbox = Session.CreateRecipient(mailboxName)
' https://learn.microsoft.com/en-us/office/vba/api/outlook.recipient.resolve
' https://learn.microsoft.com/en-us/office/vba/api/outlook.recipients.resolveall
sharedMailbox.Resolve ' Resolve name not address
If sharedMailbox.Resolved Then
Set objFolder = Session.GetSharedDefaultFolder(sharedMailbox, olFolderInbox)
For Each objItem In objFolder.Items
If TypeOf objItem Is MailItem Then
Set objMail = objItem
body_str = CStr(objMail.Body)
End If
Next
Else
'When there is an email address error as you generated
' or a mailbox name is not resolved as in the demonstration code,
' it is a setup problem.
MsgBox mailboxName & " not resolved."
End If
End Sub
The email address is sufficient without .Resolve.
When there is an email address error as you generated or a mailbox name is not resolved as in the demonstration code, it is a setup problem.