| This is my take on the Outlook code. It is written to be late-bound making it more difficult to debug, but more flexible for future releases of Outook. I have also included in the CheckMail Sub a check for Appointments with reminders. This includes the tricky open-ended re-occuring appointments. All it's missing is your code to handle new mail and appointments. Assumes:Holding open the MailFolder object will also allow Outlook to show the mew mail icon in the SysTray. I have not found any way to get rid of this icon as of yet. It will also popup reminder boxes about appointments. Please Note that the "Remind Me Again in 5 Minutes" type options will not cause the appointment to show up again with this code. Side Effects:Please note that you should not set Timer1.Interval greater than 60 seconds or you may miss appointments. Holding the MailFolder object open will also hold Outlook open in the background eating up memory but making the Outlook User-Interface much faster (at least to the user's eyes). I would recommend not checking any more than once every 2 seconds on faster PCs and once every 10 seconds on slower PCs and laptops. Network bobbles can bring a PC to it's knees if you check too often. Most of this was pieced together from the Object Browser and Vbaoutl.hlp files This is not complete code and does not do anything after recognizing that there is new mail or an appointment reminder. If you leave the MailFolder object open it will hold a copy of Outlook open in the background making the startup/shutdown of the Outlook User-Interface seemingly much faster. Since it's late-bound this code should be compliant with future releases of Outlook Option Explicit Dim oOutApp As Object Dim MailFolder As Object Dim MailExplorer As Object Dim MailItems As Object Dim CalFolder As Object Private Sub InitConnections() Dim oNS As Object On Error Goto e_Trap If oOutApp Is Nothing Then Set oOutApp = CreateObject("Outlook.Application") End If If MailExplorer Is Nothing Then Set MailExplorer = oOutApp.ActiveExplorer End If If MailFolder Is Nothing Then Set oNS = oOutApp.GetNamespace("MAPI") If Not oNS Is Nothing Then oNS.Logon Set MailFolder = oOutApp.GetNamespace("MAPI").GetDefaultFolder(6) 'olFolderInbox End If End If If CalFolder Is Nothing Then Set CalFolder = oOutApp.GetNamespace("MAPI").GetDefaultFolder(9) 'olFolderCalendar End If Exit Sub e_Trap: If Err.Number = -2147221219 Then Unload Me Exit Sub End If End Sub Private Sub CheckMail() Dim StartDate As Date Dim Item As Object Dim message As String Dim calItems As Object Dim filtItems As Object Dim mailCount As Integer Call InitConnections On Error Goto e_Trap mailCount = MailFolder.UnReadItemCount If mailCount > 0 Then ' Handle your new email event here End If 'Sets Starting Point for Appointment Filter (Will get appointments with reminders up to 5 hours in advance) StartDate = DateAdd("h", 5, Now) Set calItems = CalFolder.Items 'Required Sort by Starting time to capture re-ocurring open-ended appointments calItems.Sort "[Start]" calItems.IncludeRecurrences = True ' Filer out all but meetings in the next 5 hours. Set filtItems = calItems.Restrict("[Start] >= '" & Format(Now, "ddddd h:nn AMPM") & "' And [Start] <= '" & Format(StartDate, "ddddd h:nn AMPM") & "'") For Each Item In filtItems ' If it's an Appointment then Continue If TypeName(Item) = "AppointmentItem" Then ' 'If the Reminder is set and you're not the organizer and you're replied you'll be there If Item.ReminderSet = True And Item.ResponseRequested = False Or (Item.ResponseRequested = True And ((Item.ResponseStatus <= 3 And Item.ResponseStatus > 0) Or (Item.ResponseStatus = 0 And Item.Organizer = oOutApp.GetNamespace("MAPI").CurrentUser.Name))) Then ' If it's the right time (Check at least once per minute) If DateDiff("n", Now, Item.Start) = Item.ReminderMinutesBeforeStart Then ' Handle your appointment event here. message = Format(Item.Start, "h:mm AMPM") & " Meeting Reminder" & vbCr & Item.Location & " - " & Item.Subject End If End If End If Next Exit Sub e_Trap: Set oOutApp = Nothing Exit Sub End Sub Private Sub OpenOutlook() MailExplorer.Display End Sub Private Sub Form_Load() ' Do not set over 60 seconds if you want, to get appointment events. Timer1.Interval = 1000 End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Set MailItems = Nothing Set MailExplorer = Nothing Set MailFolder = Nothing Set CalFolder = Nothing Set oOutApp = Nothing End Sub Private Sub Timer1_Timer() Call CheckMail End Sub |
Late-Bound Outlook Code (Mail and Appointments) |
India web developer web development India | India web development company India ecommerce web developer