Copie de fichier

Signaler
Messages postés
57
Date d'inscription
mardi 24 mai 2005
Statut
Membre
Dernière intervention
10 janvier 2016
-
Messages postés
205
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
13 novembre 2009
-
Slt a tous
Je voudrais pouvoir copier un ou plusieurs fichiers d'un repertoire a un autre avec du Code Visual Basic
Merci de m'aider

2 réponses

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
FileCopy
Messages postés
205
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
13 novembre 2009

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