Connexion au Names.nsf

[Michael DELIQUE]

Names.nsf ou NAB (Notes Adresse Book)

Code : Tout sélectionner

Public Function DBOpenNAB(wOnThisServer As String) As Notesdatabase
   'ouvre le names.nsf
   
   'Déclaration des Variables   
   Dim DBNAB As NotesDatabase
   
   On Error Goto ErreurHandle
   
   If session Is Nothing Or DB Is Nothing Then
      Set session = New notesSession
      Set DB = Session.CurrentDatabase
   End If
   
   Select Case Ucase(Trim(wOnThisServer))
   Case "" 'serve en cours
      Set DBNAB = Session.GetDatabase(DB.Server,"names.nsf",False)      
   Case "LOCAL"
      Set DBNAB = Session.GetDatabase("","names.nsf",False)      
   Case Else
      Set DBNAB = Session.GetDatabase(Trim(wOnThisServer),"names.nsf",False)      
   End Select   
   
   If Not DBNAB Is Nothing Then
      If Not(DBNAB.IsOpen) Then
         Call DBNAB.Open("","")
      End If
   End If
   
   If DBExists_LS(DBNAB ) = False Then
      Set DBOpenNAB = Nothing
   Else
      If DBNAB.IsPublicAddressBook Then
         Set DBOpenNAB = DBNAB
      Else
         Set DBOpenNAB = Nothing
      End If
   End If
   
   Set DBNAB = Nothing
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Set DBNAB = Nothing
   Set DBOpenNAB = Nothing
   Exit Function

Code : Tout sélectionner

Public 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 ErreurHandle
   
   '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
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   DBExists_LS = False
   Exit Function
End Function