Gandolf_Red
09-18-2015, 06:53 AM
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. :crying:
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. :crying: