In the previous posting, I was wondering how to generate an email auto-reply that contains your next free day, based on Calendar appointments. I had been thinking of using Rules, but a comment by Jon Peltier pointed me in the right direction.
The trigger is to handle the event Application_NewMail (the handler goes in the ThisOutlookSession module):
Private Sub Application_NewMail() Dim ib As MAPIFolder Dim mi As MailItem Set ib = _ Application.Session.GetDefaultFolder(olFolderInbox) Set mi = ib.Items.GetLast RespondTo mi End Sub
The incoming message needs to be inspected for information about the sender, and responded to, if appropriate:
Sub RespondTo(mi_in As MailItem) If IsAutoRespond(mi_in) Then MakeResponse mi_in End If End Sub
An incoming message has a SenderName property. Oddly, it has a To property, but not a From property (why? am I missing something?). The SenderName is the ‘display’ name, that you typically see in the ‘From’ column of your Inbox, in preference to the actual email address. As far as I can see, this comes from the alias set up for the email account of the sender; it doesn’t correspond to any name field in the corresponding Contact (Full Name, E-mail, etc).
So we need to record the SenderName, as it appears in your Inbox, in a field of the corresponding Contact. We could add a user-defined field, but on the Details tab there’s a Nickname field, which I doubt is ever used, and so can be hi-jacked. Use of this field could be taken as enabling our auto-reply, but to be on the safe side, let’s add a user-defined field AutoRespond, set to True.
The IsAutoRespond function uses the Find function on the Contacts:
Set contact = contactsfolder.Items.Find(filter)
filter = _ "[Nickname] = " + Chr(34) + mi.SenderName + Chr(34) + _ " And [AutoRespond] = " + Chr(34) + "True" + Chr(34)
When a filter string is given as a literal, the double-quotes are doubled (e.g. “”True”"). I discovered that this isn’t necessary when using chr(34). If the Find fails, then the result variable is Nothing.
MakeResponse replies to the incoming message, using the next free date in the reply message’s body:
Sub MakeResponse(mi_in As MailItem) Dim mi_out As MailItem Dim nextfree As Date Set mi_out = mi_in.Reply With mi_out .Body = responsetext & NextFreeDay End With mi_out.Send End Sub
The NextFreeDay function goes through the Calendar looking for All-Day-Event appointments (these could be fake ones, used just to block out days; I have mine as Free time, so that they don’t clash with ‘real’ appointments). The result starts as tomorrow’s date, and gets pushed into the future, as appointments are found. Weekends and other unavailable dates should be taken into account.
The initial version is pretty basic. It would seem possible to use Calendar information in more sophisticated ways, or indeed to analyse the incoming message content.