Microsoft Access - How do I auto populate dates from my Access database into my Outlook Calendar

Asked By Miss Jones on 28-Sep-12 10:16 AM
I have a database that includes due dates for corrective action.  I want to populate these dates into my Outlook calendar so I can get reminders and share the due dates with coworkers.  Possible?
wally eye replied to Miss Jones on 28-Sep-12 01:06 PM
I just did a similar application in Excel, here is the Excel VBA:

Private Sub cmdAddReminder_Click()
  
  Dim rngDates  As Excel.Range
  Dim olApp As Outlook.Application
  Dim olAppItem As Outlook.AppointmentItem
  
  Dim arrDates    As Variant
  
  Dim intCol   As Integer
  Dim lngLastRow   As Long
  Dim lngRow  As Long
  
  Set rngDates = [A6]
  
  intCol = rngDates.Column
  lngLastRow = rngDates.Parent.Columns(intCol).Find(What:="*", _
    After:=rngDates.Parent.Cells(1, intCol), _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
    LookAt:=xlPart, LookIn:=xlValues).Row
  
  arrDates = rngDates.Resize(lngLastRow - rngDates.Row + 1, 2)
  
  Set olApp = GetObject("", "Outlook.Application")
  For lngRow = LBound(arrDates) To UBound(arrDates)
    Set olAppItem = olApp.CreateItem(olAppointmentItem)
    With olAppItem
      .Start = arrDates(lngRow, 1)
      .Subject = arrDates(lngRow, 2)
      .Duration = 1
      .ReminderSet = True
      .Save
    End With
  Next lngRow
  
  Set olAppItem = Nothing
  Set olApp = Nothing
  Set rngDates = Nothing
  
  MsgBox "Reminder added to Outlook", vbInformation, "Reminder"
  
End Sub

If you could post some particulars on the tables and their structures, I could tweak this fairly easily for you.

This code takes two columns from Excel, one with a date the second with the reminder subject, and puts them into an array.  You could get the same data into an array in Access by building an SQL string to specify the data, use the SQL string to populate a recordset, then use the GetRows command to move the recordset to an array, something like:

Option Compare Database
Option Explicit
  
Public Sub AddReminder(ByVal strCity As String)
  
'
'  Must set a reference to the Microsoft Outlook xx.x Object Library
'
  Dim dbCurr      As DAO.Database
  Dim rstReminders    As DAO.Recordset
  Dim olApp       As Outlook.Application
  Dim olAppItem     As Outlook.appointmentitem
  
  Dim arrDates      As Variant
  
  Dim strSQL      As String
  Dim lngRow      As Long
  
  Set dbCurr = CurrentDb
  strSQL = "SELECT [Response Date], [Primary Address] " _
    & "FROM TestTable " _
    & "WHERE [City] = '" & strCity & "';"
  Set rstReminders = dbCurr.OpenRecordset(strSQL)
  With rstReminders
    .MoveLast
    .MoveFirst
    arrDates = .GetRows(.RecordCount)
  End With
  
  Set olApp = GetObject("", "Outlook.Application")
  For lngRow = LBound(arrDates, 2) To UBound(arrDates, 2)
    Set olAppItem = olApp.CreateItem(olAppointmentItem)
    With olAppItem
      .Start = arrDates(LBound(arrDates, 1), lngRow)
      .Subject = arrDates(UBound(arrDates, 1), lngRow)
      .Duration = 1
      .ReminderSet = True
      .Save
    End With
  Next lngRow
    
  Set olAppItem = Nothing
  Set olApp = Nothing
  Set rstReminders = Nothing
  Set dbCurr = Nothing
  
End Sub

Just substitute in your table name and fields in the SQL statement, and set up the criteria like you want.  Here I pass it a city name and it creates reminders for all records for that city.