Sending AutoReplies from Shared Mailbox

[Gandolf_Red]

Hello,
I am working on this code for work where as we receive e-mails in a Shared Mailbox - it is a cached exchange mailbox - if certain criteria is met, outlook will auto-reply to the message from a template. I have gotten this code to work out of my own folder inbox, but am having trouble getting it to work with the Shared Mailbox. Here is my code:

Private Sub Application_Startup()
Dim Msg As Outlook.MailItem
Dim oRespond As Outlook.MailItem
Dim NS As Outlook.NameSpace
Dim objOwner As Outlook.Recipient
Set NS = Application.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("SharedMailboxName")
objOwner.Resolve

If objOwner.Resolved Then
'MsgBox objOwner.Name (This does return my shared mailbox name when not commented out)
Set Items = NS.GetSharedDefaultFolder(objOwner, olFolderInbox).Items
'Else
'MsgBox "Not resolved"
End If
End Sub

Private Sub Items_ItemChange(ByVal Item As Object)
Dim oItem As Object
Dim DestFolder As Outlook.Folder
On Error GoTo ErrMsg
If TypeOf Item Is MailItem Then
If Item.Categories = "Review" Then
Set oRespond = Application.CreateItemFromTemplate("FilePath.oft")
With oRespond
.SentOnBehalfOfName = "SharedMailboxatdomain.com"
.Recipients.Add Item.SenderEmailAddress
.Subject = "Re: xyz- " & Item.Subject
.HTMLBody = oRespond.HTMLBody & vbCrLf & "--- original message attached ---" & vbCrLf & Item.HTMLBody & vbCrLf
.Attachments.Add Item
.Send
End With
Set oRespond = Nothing
ElseIf Item.Categories = "Addressed" Then
Set oRespond = Application.CreateItemFromTemplate("FilePath.oft")
With oRespond
.SentOnBehalfOfName = "SharedMailboxatdomain.com"
.Recipients.Add Item.SenderEmailAddress
.Subject = "Re: xyz" & Item.Subject
.HTMLBody = oRespond.HTMLBody & vbCrLf & "--- original message attached ---" & vbCrLf & Item.HTMLBody & vbCrLf
.Attachments.Add Item
.Send
End With
Set oRespond = Nothing
ElseIf Item.Categories = "Denied" Then
Set oRespond = Application.CreateItemFromTemplate("FilePath.oft")
With oRespond
.SentOnBehalfOfName = "SharedMailboxatdomain.com"
.Recipients.Add Item.SenderEmailAddress
.Subject = "Re: xyz" & Item.Subject
.HTMLBody = oRespond.HTMLBody & vbCrLf & "--- original message attached ---" & vbCrLf & Item.HTMLBody & vbCrLf
.Attachments.Add Item
.Send
End With
Set oRespond = Nothing
End If
ElseIf TypeOf Item Is MeetingItem Then
End If
Exit Sub

ErrMsg:
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If

End Sub
Private Sub Items_NewMailEx(ByVal EntryIDCollection As String)
Dim arr() As String
Dim i As Integer
Dim m As MailItem

On Error GoTo ErrMsg
If TypeOf Item Is Outlook.MailItem Then
arr = Split(EntryIDCollection, ",")
For i = 0 To UBound(arr)
Set m = Application.Session.GetItemFromID(arr(i)) 'I am guessing this is where I need modification to my code
If m.Subject Like "Re:" Then
Set oRespond = Nothing
ElseIf m.Attachments.Count > 0 Then
Set oRespond = Application.CreateItemFromTemplate("FilePath.oft")
With oRespond
.SentOnBehalfOfName = "SharedMailboxatdomain.com"
.Recipients.Add m.SenderEmailAddress
.Subject = "Re: Referral Request - " & m.Subject
.HTMLBody = oRespond.HTMLBody & vbCrLf & "--- original message attached ---" & vbCrLf & m.HTMLBody & vbCrLf
.Attachments.Add m
.Send
End With
ElseIf m.Attachments.Count = 0 Then
Set oRespond = Nothing
'Set oRespond = Application.CreateItemFromTemplate("FilePath.oft")
'With oRespond
' .SentOnBehalfOfName = "sharedmailboxatdomain.com"
'.Recipients.Add m.SenderEmailAddress
'.Subject = "Re: Referral Request - " & m.Subject
'.HTMLBody = oRespond.HTMLBody & vbCrLf & "--- original message attached ---" & vbCrLf & m.HTMLBody & vbCrLf
'.Attachements.Add m
'.Display
'End With
End If
Set oRespond = Nothing
Next
Else
End If
Exit Sub

ErrMsg:
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
MsgBox Msg & "Please take a screen shot of the error message", , "Error", Err.HelpFile, Err.HelpContext
End If

End Sub


Thank you. I've been working on this for quite some time and cannot seem to figure it out.

[skatonni]

Private WithEvents Items As Items

Code in ThisOutlookSession

If not fixed, then expand on "having trouble getting it to work". What error? Which line?

[Gandolf_Red]

Thank you Skattoni, that resolves part of my issue. The Item Change sub works now. The Items_NewMailEx sub is not working. I can send e-mails to the shared mailbox with the expectation that it will reply to the e-mail as long as it has an attachment and does not start with "Re:". Nothing happens. I can run through the code, but I get no error messages, it is just that nothing initiates. Thoughts? The NewMailEx event worked before when I had it point to my olInbox upon startup, but now that I have modified it to point to the Shared Folder, it doesn't seem to initiate.

I am thinking it has something to do with this line not being specific enough to point to the shared mailbox:
Set m = Application.Session.GetItemFromID(arr(i))

Do I need to specify here that it is not just this session, but the shared mailbox? If so, how can I do that?

Thank you,
Gandolf_the_Red

[skatonni]

It is Application_NewMailEx https://msdn.microsoft.com/en-us/lib...ice.14%29.aspx

not Items_NewMailEx https://msdn.microsoft.com/en-us/lib...ice.14%29.aspx

[Gandolf_Red]

Thank you Skatonni, I had tried that first with the Application_NewMailEx and it did not work either. But after some research, I found the NewMailEx event only works in the default inbox and will not worked on my Shared Inbox. I have found an alternative and gotten it to work. Now I'm using Items_ItemAdd event.

[Russ2012]

MessageManager.docx

I have been trying to get the .SentOnBehalfOfName function to work consistently. I have developed an outlook custom process that is distributed across multiple users that needs to send a receipt message to the sender once processing of their attachments is completed. The code scans a shared mailbox and the receipt message needs to come from the shared mailbox address

The code I have written works inconsistently. It works when the code is processed on my PC and when processed on one other individual. For 2 other individuals, the code works appropriately until the step where the receipt message is generated and sent

**PLEASE NOTE** all individuals have been setup as delegates with appropriate permissions to send on behalf of the mailbox - I have visually watched the mailbox owner configure each of these individuals.


The code executes a send command but the exchange server sends back an error email which is attached but modified to exclude mailbox names, email addresses etc.

This is my code:

With olMsg
.Attachments.Add Item, olEmbeddeditem
.Subject = "**ATTENTION PURCHASING TEAM: New Supplier Item Update Form(s) have been received for CMS Processing " & (Now)
.To = "someone"
.CC = ""
.BCC = ""
.Body = Item.Body & StrBodySupplier
.SentOnBehalfOfName = "something"
.Save
SendInteger = 1
.Send
End With