Page 1 sur 1
Selectioner un répertoire
Publié:
11 Mai 2007 à 19:43par 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