Copie de fichier
aakpa
Messages postés
57
Date d'inscription
mardi 24 mai 2005
Statut
Membre
Dernière intervention
10 janvier 2016
-
9 déc. 2005 à 16:15
l0st3d Messages postés 205 Date d'inscription jeudi 19 décembre 2002 Statut Membre Dernière intervention 13 novembre 2009 - 9 déc. 2005 à 17:53
l0st3d Messages postés 205 Date d'inscription jeudi 19 décembre 2002 Statut Membre Dernière intervention 13 novembre 2009 - 9 déc. 2005 à 17:53
2 réponses
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
74
9 déc. 2005 à 16:23
9 déc. 2005 à 16:23
FileCopy
l0st3d
Messages postés
205
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
13 novembre 2009
9 déc. 2005 à 17:53
9 déc. 2005 à 17:53
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
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
