Controlling Outlook 97 from Access 97

Controlling Outlook 97 from Access 97

One of the advantages of working with Access is the ease of cross-application development with other Office programs. One of these is Outlook, which in Office 97 is supplied with all versions of Office 97. Using Outlook, it is possible to send emails with attachments, use the calendar, track appointments, etc. Below I will list how each of these may be achieved.

Note that these won't work with Outlook Express, which doesn't expose an Object Library that can be used from within Access. With Outlook Express, you are limited to using SendObject to send e-mails.

Sending e-mails

Supposing that you had an table of customers that you wanted to send an email to. It is quite easy to loop through a recordset based on the table that holds these addresses, and send each of them an individual email:

Sub sSendEMail(strSubject As String, strBody As String, Optional strAttach As String)
    Dim objOL As Outlook.Application
    Dim objOLMsg As Outlook.MailItem
    Dim objOLRecip As Outlook.Recipient
    Dim objOLAttach As Outlook.Attachment
    Dim db As Database
    Dim rs As Recordset
    Set objOL = CreateObject("Outlook.Application")
    Set db = DBEngine(0)(0)
    Set rs = db.OpenRecordset("SELECT [EMail] FROM [tblName] WHERE Not [EMail] Is Null;")
    Do
        Set objOLMsg = objOL.CreateItem(olMailItem)
        With objOLMsg
            Set objOLRecip = .Recipients.Add(rs(0))
            objOLRecip.Type = olto
            .Subject = strSubject
            .Body = strBody
            If Len(strAttach) > 0 Then
                Set objOLAttach = .Attachments.Add(strAttach)
            End If
            .DeleteAfterSubmit = True
            .Send
        End With
        rs.MoveNext
    Loop Until rs.EOF
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set objOL = Nothing
End Sub

A few notes on the above code:

Although it is possible to send one email to everybody, looping on the Set objOLRecip = .Recipients.Add("EmailName"), it is better for your customers' confidentiality if you address each email individually. Secondly, the IsMissing function will only work on Variant datatypes, so therefore I check the Length of the optional argument. Thirdly, I've deleted each email after sending, rather than cluttering up your Outbox. If it is vital that you see who you have sent emails to, just remove the line ".DeleteAfterSubmit=True". If you are deleting the sent copies, then it might be an idea to send an email to yourself, so that you have a record of it.

Note that I am providing the code for you to use if you want to. You should take great care when mass emailing, as you risk alienating customers if you send them 10 large emails a day.....

Adding Tasks

Another facility of Outlook is to add tasks, i.e. reminders to perform various actions. Again, Outlook exposes these through its object model, and it is possible to programmatically manipulate these:

Sub sAddTask(strSubject As String, strBody As String, Optional dtmDueDate As Date)
    On Error GoTo E_Handle
    Dim objOL As New Outlook.Application
    Dim objOLTask As Outlook.TaskItem
    Set objOLTask = objOL.CreateItem(olTaskItem)
    With objOLTask
        .Body = strBody
        .Subject = strSubject
        If Not IsDate(dtmDueDate) Then .DueDate = dtmDueDate
        .Save
    End With
sExit:
    On Error Resume Next
    Set objOLTask = Nothing
    Set objOL = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description, vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

Adding Appointments

Another feature that Outlook offers is the ability to add appointments to a calendar. Here is another piece of code that will allow you to use Access to add appointments to Outlook:

Sub sAddAppointment(dtmStart As Date, lngDuration As Long, strSubject As String, Optional strBody As String, Optional strLocation As String, Optional lngReminderTime As Long)
'                    lngDuration - length of appointment in minutes
'                    strSubject - title of appointment
'                    strBody - optional body of appointment
'                    strLocation - optional location of appointment
'                    lngReminderTime - optional reminder time in number of minutes
    Dim objOL As Outlook.Application
    Dim objOLAppt As Outlook.AppointmentItem
    Set objOL = CreateObject("Outlook.Application")
    Set objOLAppt = objOL.CreateItem(olAppointmentItem)
    With objOLAppt
        .Start = Format(dtmStart, "dd/mmm/yyyy") & " " & Format(dtmStart, "hh:nn")
        .Duration = lngDuration
        .Subject = strSubject
        If Len(strBody) > 0 Then .Body = strBody
        If Len(strLocation) > 0 Then .Location = strLocation
        If Len(lngReminderTime) > 0 Then
            .ReminderMinutesBeforeStart = lngReminderTime
            .ReminderSet = True
        End If
        .Save
    End With
    Set objOL = Nothing
End Sub

Top

Last modified at 06/06/2006 14:55:21