1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
| Sub ChercheDossier()
Dim numerodedossier As String
numerodedossier = "2019"
MsgBox TrouverFolderInFolder("c:\TEMP\PRINTtemp\", True, numerodedossier)
Stop
End Sub
Function TrouverFolderInFolder(strFolderName As String, bIncludeSubfolders As Boolean, partname As String) As Variant
Static Fso As Object 'FileSystemObject
Dim oSourceFolder As Object 'Scripting.Folder
Dim oSubFolder As Object 'Scripting.Folder
Dim oFile As Object 'Scripting.FILE
Set Fso = CreateObject("Scripting.FileSystemObject")
Set oSourceFolder = Fso.getfolder(strFolderName)
For Each oSubFolder In oSourceFolder.SubFolders
'' On peut mettre ici un traitement spécifique pour les dossiers
If StrComp(Left(oSubFolder.Name, 4), partname, vbTextCompare) = 0 Then
TrouverFolderInFolder = oSubFolder.path
Exit Function
End If
Next oSubFolder
If bIncludeSubfolders Then
For Each oSubFolder In oSourceFolder.SubFolders
TrouverFolderInFolder = TrouverFolderInFolder(oSubFolder.path, True, partname)
If TrouverFolderInFolder <> "" Then Exit Function
Next oSubFolder
End If
End Function |
Partager