Les Documents Profiles d'un base mail

[Michael DELIQUE]

Code : Tout sélectionner

Function MailDocProfile(wTypeDoc As String,wDBMail As NotesDatabase,nbDisplayOOODoc As Boolean,wnbSave As Boolean) As NotesDocument
   
        Dim UIWork As NotesUIWorkspace
   Dim DocProfile As NotesDocument
   Dim FormName As String
   Dim Title As String
   
   On Error Goto ErreurHandle
   
   Set MailDocProfile = Nothing
   
   Select Case Ucase(Trim(wTypeDoc))
   Case "OOO","OUTOFOFFICE","OUT OF OFFICE","OUTOFOFFICEPROFILE","OUT OF OFFICE PROFILE"
      FormName = "OutOfOfficeProfile"
      Title = " OUT OF OFFICE"
   Case "CP","CALENDARPROFILE","CALENDAR PROFILE"
      FormName = "CalendarProfile"
      Title = " CALENDAR PROFILE (PREFERENCES)"
   Case Else
      Error 9999,"wTypeDoc is Empty"
      Exit Function
   End Select
   
   If wDBMail Is Nothing Then
      Error 9999,"wDBMail is Nothing"
      Exit Function
   End If
   
   Set DocProfile = wDBMail.GetProfileDocument(FormName)
   If DocProfile Is Nothing Then
      Error 9999,"DocProfile '"+FormName+" is Nothing, on Database Mail : "+wDBMail.FilePath
      Exit Function
   End If
   
   If nbDisplayOOODoc = False Then
      If DocProfile.IsNewNote = True Then
         Set DocProfile = Nothing
      End If
   Else
      Set UIWork = New NotesUIWorkspace
      Call UIWork.DialogBox(FormName,True,True,True,False,False,False,Title,DocProfile,True,True,False)
      If wnbSave = True Then      
         Call DocProfile.Save(True,False)
      End If
   End If
   
   Set MailDocProfile = DocProfile
   Set DocProfile = 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 MailDocProfile = Nothing   
   Exit Function
End Function