Page 1 sur 1
Infos sur l'utilisateur et sa messagerie
Publié:
29 Juin 2012 à 09:20par Michael DELIQUE
- Code : Tout sélectionner
Public Function Admin_GetUserInfo(wRegistrationServer As String, wUserName As String) As Variant
Dim Registration As NotesRegistration
Dim Directory As NotesDirectory
Dim lstValue List As String
Dim nmUser As NotesName
Dim nmServer As NotesName
Dim nbMailSystem As Integer
Dim vrValue As Variant
On Error GoTo CatchError
Admin_GetUserInfo = Null
If Trim(wUserName) = "" Then
Error 9999,"wUserName is Empty"
Exit Function
End If
lstValue("USERNAME") = ""
lstValue("REGISTRATIONSERVER") = ""
lstValue("MAILSERVER") = ""
lstValue("MAILFILE") = ""
lstValue("MAILDOMAIN") = ""
lstValue("MAILSYSTEM") = ""
lstValue("MAILSYSTEMTEXT") = ""
lstValue("PROFILE") = ""
lstValue("BUILDNUMBER") = ""
lstValue("VERSION") = ""
lstValue("SHORTNAME") = ""
lstValue("INTERNETADDRESS") = ""
lstValue("OUTOFOFFICE") = ""
If Session Is Nothing Then
Set Session = New NotesSession
End If
If Trim(wRegistrationServer) = "" Then
Set nmServer = New NotesName(Session.Username)
Else
Set nmServer = New NotesName(Trim(wRegistrationServer))
End If
Set nmUser = New NotesName(Trim(wUserName))
Set Registration = New NotesRegistration
Registration.RegistrationServer = nmServer.Canonical
Call Registration.GetUserInfo(nmUser.Canonical,lstValue("MAILSERVER"),lstValue("MAILFILE"),lstValue("MAILDOMAIN"),nbMailSystem,lstValue("PROFILE"))
lstValue("REGISTRATIONSERVER") = nmServer.Canonical
lstValue("USERNAME") = nmUser.Canonical
lstValue("MAILSYSTEM") = CStr(nbMailSystem)
Select Case nbMailSystem
Case 0
lstValue("MAILSYSTEMTEXT") = "Notes"
Case 1
lstValue("MAILSYSTEMTEXT") = "cc:Mail"
Case 2
lstValue("MAILSYSTEMTEXT") = "Other"
Case 3
lstValue("MAILSYSTEMTEXT") = "X400"
Case 4
lstValue("MAILSYSTEMTEXT") = "Other Internet Mail"
Case 5
lstValue("MAILSYSTEMTEXT") = "POP or IMAP"
Case 99
lstValue("MAILSYSTEMTEXT") = "None"
Case Else
lstValue("MAILSYSTEMTEXT") = ""
End Select
Set Registration = Nothing
Set Directory = Session.getDirectory(nmServer.Canonical)
Set nmServer = Nothing
vrValue = Directory.GetMailInfo(nmUser.Canonical, True)
Set nmUser = Nothing
Set Directory = Nothing
If IsArray(vrValue) = True Then
If IsEmpty(vrValue) = False Then
lstValue("BUILDNUMBER") = Trim(CStr(vrValue(1)))
lstValue("VERSION") = Trim(CStr(vrValue(2)))
lstValue("SHORTNAME") = Trim(CStr(vrValue(4)))
lstValue("INTERNETADDRESS") = Trim(CStr(vrValue(7)))
lstValue("OUTOFOFFICE") = Trim(CStr(vrValue(8)))
End If
End If
vrValue = Null
Admin_GetUserInfo = lstValue
Erase lstValue
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
Set Registration = Nothing
Admin_GetUserInfo = Null
Exit Function
End Function