Solved: Sub - Pull Outlook calendar items to DB Table - Late Binding

[Movian]

Hey,
this is a fairly cool little sub that i found online. I updated it to fix some issues with name spacing and simplified the code a little.

However one thing I would like to do is convert it from early binding (Outlook 12.0) to late binding so that it can be used for outlook 2003, 2007 and 2010 without having to build seperate DB's. However when i remove the reference to outlook and convert the outlook data types to objects the system throws a problem with GetNameSpace... This triggers the folder selection window in outlook so you can pick which calendar to import. Any suggestions for alternatives that can be used with latebinding ?

(Origional Script here - http://www.pcreview.co.uk/forums/vba...-t2634828.html)

[vba]'---------------------------------------------------------------------------------------
' Procedure : ExportCalendarToDatabase
' DateTime : 11/09/2006 19:44
' Author : Eric Legault [MVP - Outlook]
' Purpose : Exports Outlook Calendar items to an Access database.
' : Requires Reference to Microsoft ActiveX Data Objects 2.X Library
' : Assumes existence of these fields in a table named 'tblCalendar':
' : Subject (Text) - (Nvarchar(255))
' : Contents (Memo) - (NvarChar(Max))
' : Start (Date/Time) - (DateTime)
' : End (Date/Time) - (DateTime)
'
' Example Call:
' ExportCalendarToDatabase
'
'Modfication
'Author: Richard Burgess
'Date : 02/29/2012
'Purpose: Bugfix and conversion to latebinding.
'---------------------------------------------------------------------------------------

Sub ExportCalendarToDatabase()
On Error GoTo ExportCalendarToDatabase_Error

Dim objFolder As Outlook.MAPIFolder, objItems As Outlook.Items
Dim objAppt As Outlook.AppointmentItem, objMessageObj As Object
Dim rstThis As New ADODB.Recordset, counter As Integer

rstThis.Open "tblCalendar", CurrentProject.Connection, adOpenDynamic, adLockOptimistic, adCmdTable

MsgBox "Please select the Calendar that you want to export to Access with the next dialog...", vbOKOnly + vbInformation, "Export Calendar"

Set objFolder = GetNamespace("MAPI").PickFolder
If objFolder.DefaultItemType <> olAppointmentItem Then
MsgBox "Invalid folder. Export aborted.", vbOKOnly + vbExclamation, "Invalid Folder Type"
GoTo Exitt:
End If

Set objItems = objFolder.Items
counter = 0

For Each objMessageObj In objItems
counter = counter + 1
'Forms("frmMain").Text1 = counter & " of " & objItems.Count
If objMessageObj.Class = olAppointment Then
Set objAppt = objMessageObj

'SAVE TO ACCESS DATABASE
rstThis.AddNew
rstThis("Subject").Value = objAppt.Subject
'If the Body field is a memo data type, ensure that zero length strings are allowed
If objAppt.Body <> "" Then
rstThis("Contents").Value = objAppt.Body
End If
rstThis("Start").Value = objAppt.Start
rstThis("End").Value = objAppt.End
rstThis.Update

End If
DoEvents
Next
MsgBox "Operation Complete", vbInformation
Exitt:
On Error Resume Next
Set rstThis = Nothing
Set objFolder = Nothing
Set objItems = Nothing
Set objAppt = Nothing
Set objMessageObj = Nothing

On Error GoTo 0
Exit Sub

ExportCalendarToDatabase_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure"
ExportCalendarToDatabase
Resume Next
End Sub[/vba]