Dans VB, clique sur le menu Projet, Références, et coche Microsoft Scripting Runtime
Dans un module:
Public FileCount As Long 'Contiend le nombre de fichier copier
'cette fonction ne copie que les fichier du repertoire, pas les sous dossier
Public Function CopyFiles(SrcFolder As String,DestFolder as String) as long
On Error GoTo errmsg
Dim fsFile As file,Folder as Folder,fs as FileSystemObject
set Folder = fs.GetFolder(SrcFolder)
For Each fsFile In Folder.Files
DoEvents
FileCount = FileCount + 1
fsFile.Copy DestFolder & fsFile.Name
Next
CopyFiles = FileCount
Exit Function
errmsg:
msgbox "Une Erreur est survenus pendant le copiage de fsFile.Name"
End Function
'Pour copier avec les sous-dossiers:
'Toujours \ à la fin du chemain
Public Function CopyFilesAndFolder(SrcFolder As String,DestFolder as String)
Dim rList As String 'Pile qui vas contenir les dossiers scanner
On Error GoTo errmsg
Dim sfolder As Folder
Dim nfolderi As Integer
Dim nFolder(1 To 100) As Folder
Dim FolderCount As Long
Set fs = New FileSystemObject
'On vérifis si le dossier destination existe, sinon on le crée
if fs.FolderExists(DestFolder) = false then: fs.CreateFolder DestFolder
Set nFolder(1) = fs.GetFolder(SrcFolder)
'On Copie les fichier de la racine donnée
CopyFiles nFolder(1).Path,DestFolder
nfolderi = 1
scanagain:
If nfolderi = 0 Then: Exit Function 'Les fichiers ont été copier
For Each sfolder In nFolder(nfolderi).SubFolders
DoEvents
'On vérifis si le dossier à déja été scanner
If InStr(rList, sfolder.Path) <> 0 Then
DoEvents
Else
'Le dossier n'a pas été scanner, on le copie les fichier
'Le nom du dossier est empiler dans rList
rList = rList & vbCrLf & sfolder.Path
Set nFolder(nfolderi) = fs.GetFolder(sfolder.Path)
CopiFiles sfolder.Path,DestFolder & sFolder.Name
End If
Next
If nfolderi = 1 Then
Exit Function 'Tout le dossier à été scanner
Else
'Il reste des dossiers a traiter donc on retourne dans la boucle
nfolderi = nfolderi - 1
GoTo scanagain
End If
Exit Function
errmsg:
'Perso, je fais juste quitter le dossier et j'en fais un autre. mais tu peut rmettre un debugg ici
nfolderi = nfolderi - 1
GoTo scanagain
End Function
|