vba outlook importare i dati da access nel calendario di outlook

Questo frammento di codice, illustra una tecnica di come importare i dati da Access nel calendario di Outlook tramite VBA.

Option Explicit
'variabili per la gestione del folder
Dim fld As Outlook.MAPIFolder

Private Sub ImportaDatiCalendario(StrMessaggioErrore As String)
On Error GoTo ErrorHandler
'variabili per la gestione del db
Dim recDati As New ADODB.Recordset
Dim conDati As New ADODB.Connection
'variabile per la gestione degli elementi di outlook
Dim nms As Outlook.NameSpace
Dim itms As Outlook.Items
Dim itm As Outlook.MailItem
'varie impostazioni.
Dim strCartella As String
Dim fFound As Boolean
'variabile per il messaggio di errore
Dim StrErrore As String
'oggetto mapi
Set nms = Application.GetNamespace("MAPI")
'carico il db
conDati.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Calendario.mdb;User Id=;Password=;"
'apro la connessione db
conDati.Open
'apro il recordset carico i dati
recDati.CursorLocation = adUseClient
recDati.CursorType = adOpenDynamic
recDati.LockType = adLockOptimistic
recDati.Open "select * from Calendario", conDati
'mi connetto al database
If recDati.RecordCount = 0 Then
MsgBox ("Non ci sono dati da importare per il calendario")
Exit Sub
End If
Set itms = fld.Items
Do Until recDati.EOF
'oggetto mail item
Set itm = itms.Add(olMailItem)
'campo Oggetto
If IsNull(recDati!Oggetto) = False Then itm.Subject = recDati!Oggetto
'Datainizio
If IsNull(recDati!Datainizio) = False Then itm.VotingResponse = recDati!Datainizio
'Orainizio
If IsNull(recDati!Orainizio) = False Then itm.CreationTime = recDati!Orainizio
'Datafine
If IsNull(recDati!Datafine) = False Then itm.VotingResponse = recDati!Datafine
'ora fine
If IsNull(recDati!Orafine) = False Then itm.ExpiryTime = recDati!Orafine
'ora Giornataintera
itm.ExpiryTime
itm.Close 0
'sposto il messaggio nell'apposita cartella per esserne certo
itm.Move fld
recDati.MoveNext
Loop
'chiudo il recordset e libero la memoria
recDati.Close
Set recDati = Nothing
conDati.Close
Set conDati = Nothing
End Sub