Show MsgBox upon receiving email with specified subject or sender - vba

How do I show a MsgBox or alert upon receiving a message with a specified subject or sender?
I put this procedure in ThisOutlookSession block.
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim myMail As MailItem
Dim name As String
If TypeOf Item Is MailItem Then
Set myMail = Item
If myMail.Subject Like "*Hello world*" And myMail.Categories = "" Then
MsgBox "Message", vbInformation, "approved"
MailDate = myMail.ReceivedTime
myMail.Categories = "CZEART"
myMail.MarkAsTask (olMarkNoDate)
myMail.Save
End If
End If
End Sub

To test the code, open a mailitem with the required conditions then step through this.
Option Explicit
Private Sub test()
Dim currItem As MailItem
Set currItem = ActiveInspector.currentItem
olInboxItems_ItemAdd currItem
End Sub
Likely though you need this in the ThisOutlookSession module.
Option Explicit
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
' instantiate objects declared WithEvents
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
http://www.outlookcode.com/article.aspx?id=62

Related

how to move a new mail (Excluding Re: & Fwd: ) to another folder in shared inbox

I'm trying to move the received new mails in shared inbox excluding the (Re: and FWD:) to "In progress folder". When I execute it's not working.
Error popping up in this line olReply.Move fldr
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Public WithEvents olItems As Items
Private Sub Application_Startup()
Set olItems = Session.Folders("xxx#xxx.com").Folders("Inbox").Items
End Sub
Private Sub olItems_ItemAdd(ByVal Item As Object)
Dim olReply As MailItem
Dim fldr As Outlook.MAPIFolder
If Item.Class = olMail Then
If Len(Item.ConversationIndex) > 44 Then
Exit Sub
Else
Set fldr = Outlook.Session.Folders("xxx#xxx.com").Folders("In Progress")
olReply.Move fldr
End If
End If
End Sub
I Figured out the code myself and it works perfectly. The below-mentioned code reads through the new mails which hits the shared mailbox and move to another folder if it is a new mail and skips Conversation mails.
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Public WithEvents olItems As Items
Private Sub Application_Startup()
Set olItems = Session.Folders("xxxxx#xxxx.com").Folders("Inbox").Items
End Sub
Private Sub olItems_ItemAdd(ByVal Item As Object)
Dim olNameSpace As NameSpace
Set olNameSpace = GetNamespace("MAPI")
Dim olReply As MailItem
Dim olObj As Object
Dim olDestFolder As Folder
If Item.Class = olMail Then
If Len(Item.ConversationIndex) > 44 Then ' Checks if the mail has conversation
Exit Sub
Else
Set olDestFolder = olNameSpace.Folders("xxx#xx.com").Folders("In Progress")'Set destination folder
Item.Move olDestFolder ' move to InProgress folder
End If
End If
End Sub

Send As a Delegate or a Distribution Group by default

We modified the code from this tutorial to allow us to change default send on behalf address for two mailboxes. https://www.howto-outlook.com/howto/setfromaddress.htm#quickinstall
It works perfectly in new window reply but doesn't work in reply pane.
What could be the issue?
Here is the code:
Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer
Private Sub Application_Startup()
Initialize_handler
End Sub
Public Sub Initialize_handler()
Set objInspectors = Application.Inspectors
Set myOlExp = Application.ActiveExplorer
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class = olMail Then
Set objMailItem = Inspector.CurrentItem
If objMailItem.Sent = False Then
Call SetFromAddress(objMailItem)
End If
End If
End Sub
Public Sub SetFromAddress(objItem As Outlook.MailItem)
If objItem.SentOnBehalfOfName = "info#domain1.com" Then
For i = 1 To Session.Accounts.Count
If Right(Session.Accounts(i).DisplayName, Len("#domain1.com")) = "#domain1.com" Then
objItem.SentOnBehalfOfName = Session.Accounts(i).DisplayName
Exit For
End If
Next i
Else
For i = 1 To Session.Accounts.Count
If Right(Session.Accounts(i).DisplayName, Len("#domain2.com")) = "#domain2.com" Then
objItem.SentOnBehalfOfName = Session.Accounts(i).DisplayName
Exit For
End If
Next i
End If
End Sub
'Uncomment the next 3 lines to enable Outlook 2013/2016/365 Reading Pane Reply
Private Sub myOlExp_InlineResponse(ByVal objItem As Object)
Set objMailItem = objItem
Call SetFromAddress(objMailItem)
End Sub
Inline reply won't fire the Inspector.NewInspector event. You need to use Explorer.InlineResponse event. Explorer object (assuming you only use one Explorer throughout the Outlook session) can be retrieved from Application.ActiveExplorer.

Update subject of incoming mail

I'm trying toremove the RES: and ENC: (response and forwarding in Portuguese) upon receiving a message (by rule already sent to the folder referenced in the code).
Although the code works, in msgbox the subject is displayed without the prefixes, it does not refresh the subject.
I guess it has something to do with the ByVal or ByRef; i've tried both, and it goes as I described with ByVal, while with the byRef doesn't even run.
Here's the code:
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems =
objectNS.GetDefaultFolder(olFolderInbox).Folders("TESTA").Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
Dim Msg As Outlook.MailItem
Dim assunto As String
If TypeName(Item) = "MailItem" Then
assunto = Replace(Replace(Item.Subject, "RES: ", ""), "ENC: ", "")
Item.Subject = assunto
MsgBox (assunto)
End If
End Sub
Just forget ByVal and ByRef.
Add this string after last MsgBox:
Item.Save

Close outlook task in open event

I want to open an outlook task and trigger a new journal entry.
After this I want to close this task.
I used the objTask.Close in the objTask_Open event but this gives me the following error: Argument not optional.
Is it possible to close a task in its own event function after opening ?
Best regards,
Wamor
Public WithEvents objInspectors As Outlook.Inspectors
Public WithEvents objJournal As Outlook.JournalItem
Public WithEvents objTask As Outlook.TaskItem
Private Sub Application_Startup()
Set objInspectors = Outlook.Inspectors
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If TypeOf Inspector.CurrentItem Is TaskItem Then
Set objTask = Inspector.CurrentItem
End If
If TypeOf Inspector.CurrentItem Is JournalItem Then
Set objJournal = Inspector.CurrentItem
End If
End Sub
Private Sub objTask_Open(Cancel As Boolean)
'Create journal item
Set objMyFolder = GetFolder("Archive Folders\Archive Folders")
Set objJournal = objMyFolder.Items.Add(olJournalItem)
'Fill journal with task-information
With objJournal
.StartTimer
' Retrieve the PST-file where the task is located.
.Categories = Application.ActiveExplorer.CurrentFolder.Parent
.Type = "Note"
.Subject = objTask.Subject
.Display
End With
objTask.Close
End Sub
The error message indicates "Argument not optional."
The syntax is expression.Close(SaveMode) where the argument, SaveMode, is required.
https://msdn.microsoft.com/VBA/Outlook-VBA/articles/taskitem-close-method-outlook
Choose from olDiscard or olPromptForSave or olSave.
https://msdn.microsoft.com/VBA/Outlook-VBA/articles/olinspectorclose-enumeration-outlook

Declaring WithEvents variables - Compilation error: invalid characteristics in Sub or Function"

I have two sets of code. The first code adds a preset BCC address triggered by a button. The second code enables filing of emails, by tagging/categorizing the sent email, copying that sent email and then moving the copy to the folder indicated in pickfolder.
The two codes work separately.
When I paste both codes in ThisOutlookSession, the second one does not work. The error is (loosely translated from Dutch): "compilation error: invalid characteristics in Sub or Function" which relates to all three declarations (Dim WithEvents objInspectors As Inspectors, Dim WithEvents objMyNewMail As MailItem, Dim WithEvents colSentItems As Items)
The full codes:
'button bcc to crm system emailaddress)
Sub AddCRMtoBCC()
Dim objRecip As Recipient
Set oMsg = Application.ActiveInspector.CurrentItem
With oMsg
Set objRecip = oMsg.Recipients.Add("__#__.com")
objRecip.Type = olBCC
objRecip.Resolve
End With
Set oMsg = Nothing
End Sub
'________
'file emails
Dim WithEvents objInspectors As Inspectors
Dim WithEvents objMyNewMail As MailItem
Dim WithEvents colSentItems As Items
Private Sub Application_Startup()
Set objInspectors = Application.Inspectors
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set colSentItems = NS.GetDefaultFolder(olFolderSentMail).Items
Set NS = Nothing
End Sub
Private Sub Application_Quit()
Set objInspectors = Nothing
Set objMyNewMail = Nothing
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class <> olMail Then Exit Sub
Set objMyNewMail = Inspector.CurrentItem
End Sub
Private Sub objMyNewMail_Send(Cancel As Boolean)
If MsgBox("Are you sure you want to send this message?", vbYesNo + vbQuestion _
, "SEND CONFIRMATION") = vbNo Then
Cancel = True
End If
End Sub
Private Sub colSentItems_ItemAdd(ByVal Item As Object)
If Item.Class = olMail Then
Set Copy = Item.Copy
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
Copy.Move objFolder
End If
End Sub
When you declare global variables at module level (ThisOutlookSession is a module), all of them should be declared at the top of the module.
thus, move those 3 lines at the top , before the very first sub()
Dim WithEvents objInspectors As Inspectors
Dim WithEvents objMyNewMail As MailItem
Dim WithEvents colSentItems As Items
objMyNewMail_Send() Cancel parameter must be declared ByRef