Renvoie sous forme d'un tableau à 4 dimensions les fichiers d'un répertoire.
Avec possibilité de masque comme sous Clipper
dim tableau() as string
Tableau=Adir(repertoire,masque)
Source / Exemple :
Function Adir(repert, Optional masque As String)
Dim fld As Folder
Dim i As Integer
Dim atab()
Dim condition As String
Set fld = FSO.GetFolder(repert)
Dim f As File
FichCount = 0
For Each f In fld.Files
If CalculeCondition(masque, f.Name) Then
FichierCount = FichCount + 1
Fichier(FichierCount, 1) = f.Path
Fichier(FichierCount, 2) = f.Name
Fichier(FichierCount, 3) = f.DateLastModified
Fichier(FichierCount, 4) = f.Size
End If
Next
If FichierCount = 0 Then
ReDim atab(1, 4)
Else
ReDim atab(FichierCount, 4)
For i = 1 To FichierCount
For j = 1 To 4
atab(i, j) = Fichier(i, j)
Next
Next
End If
Adir = atab
End Function
Function CalculeCondition(var, strfile)
Dim condition As Boolean
condition = False
For i = 1 To Len(var)
If Mid(var, i, 1) <> "?" And Mid(var, i, 1) <> "*" Then
If Mid(var, i, 1) = "." Then
Exit For
End If
If LCase(Mid(strfile, i, 1)) = LCase(Mid(var, i, 1)) Then
condition = True
Else
condition = False
Exit For
End If
End If
Next
If InStr(var, ".") > 0 And condition = True Then
If Right(var, 1) = "*" Then
condition = True
Else
If LCase(Right(strfile, 3)) = LCase(Mid(var, InStr(var, ".") + 1)) Then
condition = True
Else
condition = False
End If
End If
End If
CalculeCondition = condition
End Function
Conclusion :
Inclure dans les références SCRRUN.DLL
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.