Import/Link Outlook Tasks into Access

[padlocked17]

So I have tried using the Import Wizard to import/link Outlook Tasks into Access, and it works great except for the fact that it doesn't include the Subject or Message of the task making it completely useless.

Does anyone know of a way to read/import/link Outlook 2007 Tasks from within an Access 2007 Database?

 

[Moniker]

Instead of the very limited wizard, connect to Outlook directly, and you can pull all the data. Pseudo-coded so you get the idea:

Dim OLApp As Outlook.Application

Set OLApp = New Outlook.Application

Then, through the OLApp object, you can get everything from Outlook that you want. Use IntelliSense to see all the available properties/methods. You may also need another object (not sure as I've never tried to grab tasks out of Outlook, but I know that email is Dim OLMsg As Outlook.MailItem). Note that you'll need to add the MS Outlook Object Library to your references for this to work.

 

[padlocked17]

I've got this article here, but I'm really lost on how to implement.

Could you possibly help point me in the right direction. I've got the following code sorted out. I know it's not in the proper order, it's just what I've gotten copied over so far.

Private Sub Outlook()
Dim appOutlook As Outlook.Application
Dim appNS, appTasks
Dim AppItems As Outlook.Items

Set appOutlook = New Outlook.Application
Set appNS = appOutlook.GetNamespace("MAPI")
Set appTasks = appNS.GetDefaultFolder(olFolderTasks)
Set AppItems = appTasks.Items


ItemCount = AppItems.Count

' set up append query statements for every task

On Error GoTo 0
For i = 1 To ItemCount
  itPerComp = AppItems(i).PercentComplete
  If itPerComp < 100 And _
    AppItems(i).status <> olTaskDeferred Then
    On Error Resume Next
    If (Not IsMissing(CatRequired) And _
      AppItems(i).Categories = CatRequired) Or _
      IsMissing(CatRequired) Then
      On Error GoTo 0
      DoCmd.Echo True, AppItems(i).Subject
      itDateCreated = AppItems(i).CreationTime
      itSubject = AppItems(i).Subject
      itBody = AppItems(i).Body
      itCategory = AppItems(i).Categories
      itImportance = AppItems(i).Importance
    End If
  End If
Next
Set appOutlook = Nothing



Call AddOutlookTasks(User_FX)

itSubject = AppItems(i).Subject
itBody = AppItems(i).Body

With rstTasks
  .AddNew
  !DateCreated = itDateCreated
  !Subject = itSubject
  !Category = itCategory
  !Body = itBody
  !PercentComplete = itPerComp
  !Importance = itImportance
          
' Add the NT/WinXP/Win2000 username
  !SystemUsername = userNameRequired
          
  .Update
End With


End Sub


Sub AddOutlookTasks(userNameRequired As String, _
Optional CatRequired As Variant)
End Sub

Sub DeleteOutLookTasks()
Const outlookTbl = "tblOutlookTasks"
Dim qryStr As String

qryStr = "delete from " & outlookTbl & _
 " OutlookTasks where systemUserName = '" _
 & userNameRequired & "'"
If Not IsMissing(CatRequired) Then
  qryStr = qryStr & " and category = '" & CatRequired & "'"
End If
 
DoCmd.SetWarnings False
DoCmd.RunSQL qryStr
DoCmd.SetWarnings True

End Sub