Connexion au carnet d'adresse public

[Michael DELIQUE]

Code : Tout sélectionner

Function DBCAPublic As Notesdatabase
   'renvois un variable de type NotesDatabase contenant le carnet d'adresse public
   
   'Déclaration des Variables   
   Dim dbCAP As NotesDatabase
   Dim nbCAPopen As Integer
   
   On Error Goto ErreurDBCAPublic
   
   If session Is Nothing Then
      Set session = New notesSession
   End If
   
   Forall ValueAB In session.AddressBooks   
      If ValueAB.IsPublicAddressBook Then
         Set dbCAP = ValueAB
         Exit Forall
      End If   
   End Forall
   
   nbCAPopen = DBExists_LS(dbCAP )
   If nbCAPopen = False Then
      nbCAPopen = dbCAP.Open("","")
   End If
   
   If nbCAPopen = False Then
   '   Error 9999,  "Le Carnet d'Adresse Public est introuvable."
      Set DBCAPublic = Nothing
   Else
      Set DBCAPublic = dbCAP
   End If
   
   Set dbCAP = Nothing
   Exit Function
ErreurDBCAPublic:
   Msgbox "(DBCAPublic) Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   
   Set dbCAP = Nothing
   Set DBCAPublic = Nothing
   Exit Function
End Function

Function DBExists_LS(wdb As NotesDatabase) As Integer
   'teste si une base de donnée est accéssible
'   renvoi true si elle est accéssible
' renvoi false si elle n'est pas accessible
   
   On Error Goto ErreurDBExists_LS
   
   'teste si la variable est renseigné
   If wDB Is Nothing Then
      DBExists_LS = False
      Exit Function
   Else
      'teste si la base est ouverte
      If wDB.IsOpen = True Then
      'teste si la base existe réelement il faut que la date de crétation existe ainsi que l'id de réplique
         If Trim(Cstr(wDB.Created)) = "" Or Trim(Cstr(wDB.ReplicaID)) = "" Then
            DBExists_LS = False
            Exit Function
         End If
      Else
         DBExists_LS = False
         Exit Function
      End If
   End If
   
   DBExists_LS = True
   
   Exit Function
ErreurDBExists_LS:
   Msgbox "(DBExists_LS) Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   DBExists_LS = False
   Exit Function
End Function