Selectioner un répertoire

[Michael DELIQUE]

Code : Tout sélectionner

Public Function DirectorySelect(wTitle As String, wDirectoryByDefault As String) As String
   
      'déclaration Variable
   Dim vrValue As Variant
   Dim Title As String
   Dim Directory As String
   
   On Error Goto ErreurHandle
   
   If UIWork Is Nothing Then
      Set UIwork = New NotesUIworkSpace
   End If
   
   DirectorySelect = ""
   
   If Trim(wTitle) = "" Then
      If DB Is Nothing Or Session Is Nothing Then
         Set Session = New NotesSession
         Set DB = Session.CUrrentdatabase
      End If
      Title = " "+Ucase(db.Title)
   Else
      Title = " "+Trim(wTitle)
   End If
   
   Directory = "c:\"
   
   If Trim(wDirectoryByDefault) <> "" Then
      If IsValideDirectory(Trim(wDirectoryByDefault)) = True Then
         Directory = Trim(wDirectoryByDefault)
      End If
   End If
   
   vrValue = UIwork.SaveFileDialog(True,Title,,Directory)
   
   Title = ""
   
   If Testvariant(vrValue) = False Then
      Exit Function
   End If
   
   DirectorySelect= Trim(vrValue(0))
   
   vrValue = Null
   
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo(1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+"."+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   DirectorySelect = ""
   Exit Function
End Function

Code : Tout sélectionner

Public Function TestVariant(vrValue As Variant) As Integer
   
   'Cette fonction permet de savoir si un variant est renseigné.
   'renvois false si la variable est vide, nul ou égale à nothing
   'si la variable est une liste ou un tableau renvoi false si il n'y a aucune ligne
   
   'déclaration Variable
   Dim i As Long
   
   On Error Goto ErreurHandle
   
   Select Case Datatype(vrValue)
   Case 0,1,9,10 ' EMPTY,NULL,OLE object or NOTHING
      TestVariant = False
   Case Else
     
      If Isempty(vrValue) = True Then
         TestVariant = False
         Exit Function
      End If
     
      i = 0
      If Isarray(vrValue) Or Islist(vrValue) Then
         Forall Value In vrValue
            i = i+1
            If i > 2 Then
               'pour eviter un traitement trop long s'il ya bcp de valeurs
               Exit Forall
            End If
         End Forall
         
         If i = 0 Then
            TestVariant = False
         Else
            TestVariant = True
         End If
      Else
         TestVariant = True
      End If
      i = 0
   End Select
   
   
   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 !"
   TestVariant = False
   Exit Function
End Function