FILE_ATTRIBUTE_DIRECTORY 16 (0x10) The handle that identifies a directory.
J'ai besoin de texter l'existence (ou non) d'un sous-répertoire, c'est à dire savoir si AU MOINS UN sous-répertoire existe ou non dans un dossier donné.
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject") Dim ObjRep: Set ObjRep = FSO.GetFolder("c:\windows") 'dossier Dim ObjSubRep: Set ObjSubRep = ObjRep.SubFolders 'sous-dossiers MsgBox "Vous avez dans le dossier c:\windows\ " & ObjSubRep.Count & " dossiers !"
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questiondossier = "d:\abcdefg" If Dir(dossier, vbDirectory) <> "" Then MsgBox dossier & " existe" Else MsgBox "n' existe pas": Exit Sub sousdossier = Dir(dossier & "", vbDirectory) Do While sousdossier <> "" If sousdossier <> "." And sousdossier <> ".." Then If (GetAttr(dossier & "" & sousdossier) And vbDirectory) = vbDirectory Then toto = toto & vbCrLf & sousdossier End If End If sousdossier = Dir Loop If toto "" Then toto vbCrLf & "aucun" MsgBox dossier & " contient le(s) sous-dossier(s)" & toto
Private Function contient_x_sousdossiers(dossier As String) As Integer sousdossier = Dir(dossier, vbDirectory) Do While sousdossier <> "" If sousdossier <> "." And sousdossier <> ".." Then contient_x_sousdossiers = contient_x_sousdossiers + 1 sousdossier = Dir Loop End Function
MsgBox contient_x_sousdossiers("d:\abcdefg")
je vais encore au-delà de ce qui est demandé par CaladeMerci pour lui
@ucFoutu: Ta solution est la 1ère à laquelle j'avais pensé, mais comme le dit Active, il faut x lignes de code et une boucle pour un simple test d'existence d'un dossier. Quant à FSO, cela alourdit d'autant l'exe final
If Dir(dossier, vbDirectory) <> ""
Dim Ls As Control Private Sub Form_Load() Set Ls = Controls.Add("VB.DirListBox", "Dirextory1") End Sub Private Sub Command1_Click() Ls.Path = "c:\tempo" Ls.Refresh If Ls.ListCount > 0 Then MsgBox "Vous avez un (des) dossier(s)" Else MsgBox "Vous n'avez aucun dossier" End If End Sub
- Si ce n'est que pour vérifier l'existence d'un dossier, une seule ligne de code suffit !
' Déclaration de l'API Public Declare Function FindFirstFileEx Lib "kernel32.dll" Alias "FindFirstFileExA" (ByVal lpFileName As String, ByVal fInfoLevelId As FINDEX_INFO_LEVELS, lpFindFileData As Any, ByVal fSearchOp As FINDEX_SEARCH_OPS, lpSearchFilter As Any, ByVal dwAdditionalFlags As Long) As Long 'Les enums transposés du C et numérotés pour plus de lisibilité Public Enum FINDEX_INFO_LEVELS FindExInfoStandard = 0& FindExInfoBasic = 1& ' NOT SUPPORTED before W7 FindExInfoMaxInfoLevel = 2& End Enum #If False Then Private FindExInfoStandard, FindExInfoBasic, FindExInfoMaxInfoLevel #End If Public Enum FINDEX_SEARCH_OPS FindExSearchNameMatch = 0& FindExSearchLimitToDirectories = 1& FindExSearchLimitToDevices = 2& FindExSearchMaxSearchOp = 3& End Enum #If False Then Private FindExSearchNameMatch, FindExSearchLimitToDirectories, FindExSearchLimitToDevices, FindExSearchMaxSearchOp #End If ' Ma fonction d'appel Public Function BH_IsAnyFolder(ByVal FolderName As String, Optional ByVal Filter As String = "*") As Boolean Dim W32_F_D_Buffer As WIN32_FIND_DATA, lngHandle As Long FolderName = BH_AddBackSlash2Folder(FolderName) & Filter lngHandle = FindFirstFileEx(FolderName, FindExInfoStandard, W32_F_D_Buffer, FindExSearchLimitToDirectories, 0&, 0&) if lngHandle > 0 then BH_IsAnyFolder=true call FindClose(lngHandle) End Function
call FindClose(lngHandle)
Set Ls Controls.Add("VB.DirListBox", "Dirextory1"): Ls.Path "c:\tempo": Ls.Refresh: MsgBox "Dossiers : " & Ls.ListCount: Controls.Remove Ls