Close outlook task in open event - vba

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

Related

How to set reminder for incoming or outgoing meeting requests

When I create/update meeting requests OR receive a meeting request (skype/team meeting or regular meeting), I want to check if a reminder has been set. If not, set a reminder for 15 minutes before the meeting.
Some searching brought me code I included in the "ThisOutlookSession" module. No reminders are added.
Public WithEvents objCalendar As Outlook.Folder
Public WithEvents objCalendarItems As Outlook.Items
Private Sub Application_Startup()
Set objCalendar = Outlook.Application.Session.GetDefaultFolder(olFolderCalendar)
Set objCalendarItems = objCalendar.Items
End Sub
Private Sub objCalendarItems_ItemAdd(ByVal Item As Object)
Call SetReminder(Item)
End Sub
Private Sub objCalendarItems_ItemChange(ByVal Item As Object)
Call SetReminder(Item)
End Sub
Private Sub SetReminder(ByVal objCalendarItem As Object)
If TypeOf Item Is MeetingItem Then
Set objMeetingRequest = Item
Set objMeeting = objMeetingRequest.GetAssociatedAppointment(True)
'Check if reminder existing
If objMeeting.ReminderSet = False Then
objMeeting.ReminderSet = True
objMeeting.ReminderMinutesBeforeStart = 15
objMeeting.Save
End If
End If
End Sub
First of all, there is no Item object passed to the SetReminder method.
You need to check for AppointmentItem instead of MeetingItem in the code.
Private Sub SetReminder(ByVal objCalendarItem As Object)
Dim objMeeting as AppointmentItem
If TypeOf objCalendarItem Is AppointmentItem Then
Set objMeeting = objCalendarItem
'Check if reminder existing
If objMeeting.ReminderSet = False Then
objMeeting.ReminderSet = True
objMeeting.ReminderMinutesBeforeStart = 15
objMeeting.Save
End If
End If
End Sub
If required you may check out the MeetingStatus property.

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.

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

Show MsgBox upon receiving email with specified subject or sender

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

Implementing an interface in ThisOutlookSession is not working in Office 2013

I have an Outlook macro I wrote that will automatically mark items as read when I move them to a folder. (I hate having unread messages in folders other than my Inbox.) I wrote the macro in Outlook 2010, and it's been functioning well for years.
I recently upgraded to Office 2013, and now my macro doesn't work--I'm getting a type mismatch error on this line (see below for the full code):
Set oMoveHandler.Callback = Me
oMoveHandler.Callback expects an object of type IMessageMoved, which the object implements, so I'm not sure why I'm getting this error. Any ideas?
ThisOutlookSession code:
Option Explicit
Implements IMessageMoved
Private m_oFolderCollection As Collection
Private Sub Application_Quit()
Set m_oFolderCollection = Nothing
End Sub
Private Sub Application_Startup()
Dim oFolder As Outlook.Folder
Set m_oFolderCollection = New Collection
For Each oFolder In Application.GetNamespace("MAPI").Folders
Call AddFolder(oFolder)
Next oFolder
End Sub
Private Sub AddFolder(Folder As Outlook.Folder)
Dim oFolder As Outlook.Folder
Dim oMoveHandler As MoveHandler
If Folder Is Nothing Then
Exit Sub
End If
If Folder.Folders.Count = 0 Then
Exit Sub
End If
For Each oFolder In Folder.Folders
If oFolder.DefaultItemType = olMailItem Then
If oFolder.Name <> "Inbox" And oFolder.Name <> "Outbox" And oFolder.Name <> "ePrescribing Workgroup" Then
Set oMoveHandler = New MoveHandler
Set oMoveHandler.Folder = oFolder.Items
Set oMoveHandler.Callback = Me
Call m_oFolderCollection.Add(oMoveHandler)
Set oMoveHandler = Nothing
End If
Call AddFolder(oFolder)
End If
Next oFolder
End Sub
Private Function IMessageMoved_MessageMoved(Item As Object) As Variant
On Error Resume Next
Item.UnRead = False
On Error GoTo 0
End Function
IMessageMoved:
Public Function MessageMoved(Item As Object)
End Function
MoveHandler:
Private WithEvents m_oFolder As Outlook.Items
Private m_oCallback As IMessageMoved
Public Property Set Folder(Folder As Outlook.Items)
Set m_oFolder = Folder
End Property
Public Property Get Folder() As Outlook.Items
Set Folder = m_oFolder
End Property
Public Property Set Callback(Object As IMessageMoved)
Set m_oCallback = Object
End Property
Private Sub Class_Terminate()
Set m_oFolder = Nothing
Set m_oCallback = Nothing
End Sub
Private Sub m_oFolder_ItemAdd(ByVal Item As Object)
If Not m_oCallback Is Nothing Then
Call m_oCallback.MessageMoved(Item)
End If
End Sub
I suspect I was actually running into a similar issue to the one described in this post describing a similar problem in Excel where binding just wasn't working as expected. To work around it, I ended up moving my interface out of ThisOutlookSession into a separate class which I then just instantiate from ThisOutlookSession.