Liste des Bases
Publié: 08 Fév 2010 à 15:52- Code : Tout sélectionner
Public Function DBListe(wServerName As String,wTypeDB As String) As Variant
'renvois la liste des bases d'un server
'Déclaration Variable
Dim Directory As NotesDbDirectory
Dim nmServer As NotesName
Dim DB_EXT As Notesdatabase
Dim i As Integer
Dim nbTypeDB As Integer
Dim lstDB List As String
On Error Goto ErreurHandle
'Selection du type de database a afficher
nbTypeDB = 0
Select Case wTypeDB
Case "1247","DATABASE","NOTES_DATABASE","NSF"
nbTypeDB = 1247
Case "1248","TEMPLATE","NTF"
nbTypeDB = 1248
Case "1245","REPLICA_CANDIDATE"
nbTypeDB = 1245
Case "1246","TEMPLATE_CANDIDATE"
nbTypeDB = 1245
Case Else
nbTypeDB = 1247
End Select
If DB Is Nothing Or Session Is Nothing Then
Set Session = New NotesSession
Set DB = Session.CUrrentdatabase
End If
'connexion a l'objet directory
Set Directory = Nothing
If Trim(wServerName) = "" Then
Set nmServer = New NotesName(DB.server)
Set Directory = Session.GetDbDirectory( DB.server )
Else
Set nmServer = New NotesName(wServerName)
Set Directory = Session.GetDbDirectory( wServerName )
End If
Set nmServer = Nothing
If Directory Is Nothing Then
Error 9999,"Directory is Nothing"
Exit Function
End If
i = 0
Set DB_EXT = Directory.GetFirstDatabase(nbTypeDB)
While Not (DB_EXT Is Nothing)
i = i+1
lstDB(i) = DB_EXT.FilePath
Set DB_EXT = Directory.GetNextDatabase
Wend
Set DB_EXT = Nothing
Set Directory = Nothing
If i = 0 Then
Set DBListe = Nothing
Else
DBListe = lstDB
End If
Erase lstDB
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 !"
DBListe= False
Exit Function
End Function
