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
| Const RETURNONLYFSDIRS = &H1
Const ForAppending = 8
Set oShell = CreateObject("Shell.Application")
Set Folder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", RETURNONLYFSDIRS, "\\Spiwebindex\scan\Coupons\img")
If Folder is Nothing Then
MsgBox "Abandon opérateur",vbCritical
Else
Set FolderItem = Folder.Self
End If
Dim stRep 'Nom du répertoire à parcourir
Dim FSO,Fld
stRep = FolderItem.Path
nomRep = FolderItem.Name
Set FSO = CreateObject("Scripting.FileSystemObject")
Set NewFile = FSO.CreateTextFile(stRep&"\"&nomRep&".csv", True)
If FSO.FolderExists(stRep) Then
For each Fld in FSO.GetFolder(stRep).SubFolders
NewFile.WriteLine(Fld.Name&";"&Fld.Files.Count)
Next
NewFile.Close
Set AppFile = FSO.OpenTextFile(stRep&"\"&nomRep&".csv",ForAppending, True)
AppFile.WriteLine("TOTAL"&";")
AppFile.Close
End If
Set FolderItem = Nothing
Set Folder = Nothing
Set oShell = Nothing |
Partager