Please help Event

my code in vb6 :

 

Dim StrSujet  As String
  Dim StartTime As Date, EndTime As Date
  Dim lngTmpIdSoin As Long
 
  Dim RR As ADODB.Recordset
  Dim RE As ADODB.Recordset
  Dim RC As New ADODB.Recordset
 
  Dim calEvent As CalendarEvent
 
  Set RE = New ADODB.Recordset
  Set RC = New ADODB.Recordset
  Set RR = New ADODB.Recordset
 
  strSQL = "SELECT * FROM AGENDA WHERE IdSite = " & lngNSite & "  AND Supprimer = 0"
  RE.Open strSQL, ObjConnect.ADOConnectionObject, adOpenStatic
 
  Do While Not RE.EOF
    StartTime = RE.Fields("DateHeureRVD").Value
    EndTime = RE.Fields("DateHeureRVF").Value
    StrSujet = vbNullString
   
    Set calEvent = g_DataResourcesMan.DataProvider(0).CreateEventEx(RE.Fields("IdAgenda").Value)
    'Set calEvent = Me.CalendarControl.DataProvider.CreateEventEx(RE.Fields("IdAgenda").Value)
    calEvent.StartTime = StartTime
    calEvent.EndTime = EndTime
   
    strSQL = "SELECT * FROM CLIENT WHERE IdClient =  " & RE.Fields("IdClient").Value & " AND IdSite = " & lngNSite
    RC.Open strSQL, ObjConnect.ADOConnectionObject, adOpenStatic
    If Not RC.EOF Then
      strSQL = "SELECT * FROM CIVILITE WHERE IdCivilite = " & RC.Fields("IdCivilite").Value
      RR.Open strSQL, ObjConnect.ADOConnectionObject, adOpenStatic
      If Not RR.EOF Then
        StrSujet = StrSujet & RR.Fields("Libelle").Value & Space$(1) & RC.Fields("Nom").Value & " " & RC.Fields("Prenom").Value
      Else
        StrSujet = StrSujet & RC.Fields("Nom").Value & " " & RC.Fields("Prenom").Value
      End If
      RR.Close
    Else
      StrSujet = "Aucun Client"
    End If
    RC.Close
    StrSujet = StrSujet & Space$(1) & FormatDateTime(StartTime, vbShortTime) & " - " & FormatDateTime(EndTime, vbShortTime)
    calEvent.Subject = StrSujet
    calEvent.ScheduleID = RE.Fields("IdLieu").Value
    calEvent.CustomProperties("IdAgenda") = RE.Fields("IdAgenda").Value
    calEvent.CustomProperties("IdLieu") = RE.Fields("IdLieu").Value
    calEvent.BusyStatus = xtpCalendarBusyStatusBusy
   
    'Afficher les soins Agendas
    If RetrieveEnv("AFFICHER_SOIN_AGENDA", , True) <> "0" And RetrieveEnv("AFFICHER_SOIN_AGENDA", , True) <> vbNullString Then
      If RE.Fields("IdSoin").Value > 0 Then
        If RE.Fields("IdSousSoin").Value > 0 Then
          lngTmpIdSoin = RE.Fields("IdSousSoin").Value
        Else
          lngTmpIdSoin = RE.Fields("IdSoin").Value
        End If
        strSQL = "SELECT * FROM ARTICLE WHERE IdArticle = " & lngTmpIdSoin
        RR.Open strSQL, ObjConnect.ADOConnectionObject, adOpenStatic
        If Not RR.EOF Then
          calEvent.Location = "Soins : " & RR.Fields("Libelle").Value & IIf(RR.Fields("Duree_Abonnement").Value > 0, " (" & RR.Fields("Duree_Abonnement").Value & " min.)", vbNullString)
        Else
          calEvent.Location = "Soins : " & "Aucun"
        End If
        RR.Close
    
      Else
        calEvent.Location = "Soins : " & "Aucun"
      End If
    End If
   
    'Afficher les Estheticienne Agendas
    strSQL = "SELECT * FROM VACATAIRE WHERE IdVacataire = " & RE.Fields("IdOperateur").Value
    RR.Open strSQL, ObjConnect.ADOConnectionObject, adOpenStatic
    If Not RR.EOF Then
      calEvent.Body = "Esthéticien(ne) : " & RR.Fields("Nom").Value & Space$(1) & RR.Fields("Prenom").Value
    Else
      calEvent.Body = "Esthéticien(ne) : Aucun"
    End If
    RR.Close
    g_DataResourcesMan.DataProvider(0).AddEvent calEvent
    'Me.CalendarControl.DataProvider.AddEvent calEvent
    CalendarControl.Populate
    CalendarControl.RedrawControl
   
    RE.MoveNext
  Loop
  RE.Close

 

Thanks

 

Public Sub OpenProvider(ByVal eDataProviderType As CodeJockCalendarDataType, ByVal strConnectionString As String)
    Set m_pCustomDataHandler = Nothing
   
    ' SQL Server provider
    If eDataProviderType = cjCalendarData_SQLServer Then
        Set m_pCustomDataHandler = New providerSQLServer
        '' Create DSN "Calendar_SQLServer" to connect to SQL Server Calendar DB
        m_pCustomDataHandler.OpenDB strConnectionString
        m_pCustomDataHandler.SetCalendar CalendarControl
    End If
               
    CalendarControl.SetDataProvider strConnectionString
   
    If eDataProviderType = cjCalendarData_SQLServer Then
        CalendarControl.DataProvider.CacheMode = xtpCalendarDPCacheModeOnRepeat
    End If
    CalendarControl.DataProvider.Create
    If Not CalendarControl.DataProvider.Open Then
        CalendarControl.DataProvider.Create
    End If
   
    m_eActiveDataProvider = eDataProviderType
       
    CalendarControl.Populate
    DatePicker.RedrawControl

End Sub