Connexion au Names.nsf
Publié: 02 Déc 2009 à 10:58Names.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