Error running code on share mail box
Hi,
I am using the below code to print the attachments of selected e-mails on any folder in outlook. But when I am running this on a local Inbox folder this code is working pretty much in the expected manner, But unfortunately my requirement is to select the mails in a Shared Mailbox and print the attachments. I am experiencing error
Run-time error '-21477221233 (8004010f)': Method 'Attachments' of object 'MailItem' failed.
The same was happening for me when I am using code in KB522 on shared mailbox with some modification. Refthread KB522 RuntimeError in TargetFolderItems_ItemAdd )
Can you please let me know what to change in code in order to get the below code work for Shared Mail box?
Thanks in advance
[vba]Public Sub PrintSelectedMails()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim j As Long
Dim lngCount As Long
Dim Response As Integer
Dim msg As String
Dim strSubject As String
Dim dispname As String
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
' Check selected item for attachments.
For i = objSelection.Count To 1 Step -1
lngCount = objSelection(i).Attachments.Count
If lngCount > 0 Then
strSubject = objSelection(i).Subject
If strSubject = "" Then
msg = "Selected item #" & i
Else
msg = strSubject
End If
' Response = MsgBox(msg & " has attachments." & vbCr _
' & "Do you wish to delete?", vbYesNo)
' If Response = vbNo Then
'objSelection(i).PrintOut
Set objAttachments = objSelection(i).Attachments
For j = 1 To objSelection(i).Attachments.Count
dispname = "P:\" & objAttachments.Item(j).DisplayName
objAttachments.Item(j).SaveAsFile dispname
ShellExecute 0&, "print", dispname, 0, "P:\", 12
'objSelection(i).Attachments(j).Print
Next j
' Else
' objSelection(i).PrintOut
' 'objSelection(i).Delete
' End If
' Else
' objSelection(i).PrintOut
' 'objSelection(i).Delete
End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub[/vba]