Hi guys,
I have written this outlook macro which works fine on your personal mailbox but it gives an error when I'm trying to run it on the shared mailbox:
On Error Resume Next
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Dim strRowData As String
Dim strDelimiter As String
Dim myDestFolder As Outlook.Folder
Dim olRecip As Outlook.Recipient
Dim ShareInbox As Outlook.MAPIFolder
Dim SubFolder As Object
Dim InputFolder As String
Dim OutputFolder As String
Dim ProdMail As String
Dim SavePath As String
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
'~~> Open the relevant file
SavePath = "\\C:\Macro"
Set oXLwb = oXLApp.Workbooks.Open(SavePath & "\Test.xlsx")
'Extract Mailbox and subfolder details from a sheet named as "Folder Details"
Set oXLws = oXLwb.Sheets("Folder Details")
ProdMail = oXLws.Range("B1")
InputFolder = oXLws.Range("B2")
OutputFolder = oXLws.Range("B3")
strRowData = ""
' Code to extract emails from specific subfolder within shared folder and copy the data across excel spreadsheet.
Set olRecip = mynamespace.CreateRecipient(ProdMail)
Set ShareInbox = mynamespace.GetSharedDefaultFolder(olRecip, olFolderInbox)
Set SubFolder = ShareInbox.Folders(InputFolder) 'Change this line to specify folder
Set myDestFolder = ShareInbox.Folders(OutputFolder)
The error is on the below line:
Set SubFolder = ShareInbox.Folders(InputFolder)
Below is the error message :
Run-time error -2147221233 (8004010f):` The attempted operation failed. An object could not be found.
Can anyone please help to troubleshoot this issue? Why the macro is working fine on personal mailbox but not on the shared mailbox.
Many Thanks,
Aman