Discussion :

[flo127]

Bonjour à tous,

Je suis débutant en VBA et j'ai grandement besoin d'un petit programme qui me permettrait de copier automatiquement des dossiers dont le chemin se trouve dans des cellules excel.

Jusque là c'est bon j'ai réussi, toutefois l'opération ne fonctionne que pour une ligne..

Ce que j'aimerai c'est que cette action fonctionne pour toutes les lignes qui sont remplies dans excel. Donc j'ai deux colonnes, la premier "Dossier source" et la seconde "Dossier cible".

De plus, je n'arrive pas à faire fonctionner la progressbar pour informer de l'avancée des copies. J'ai compris comment cela fonctionne avec des lignes excel mais pas lorsqu'il s'agit d'une fonction FSO, en loccurance ici Copyfolder. Le nombre de dossier à copier sera différent chaque semaine donc je ne peux pas estimer la taille à chaque fois.

Voice le code de ma Userform

Code vb :

Sélectionner tout - Visualiser dans une fenêtre à part

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
35
36
37
38
39
40
Private Sub CommandButton1_Click() 
Dim MySource01 As String 
Dim MyDestination01 As String 
 
MySource01 = Sheets("Source").Range("A3").Value 
MyDestination01 = Sheets("Source").Range("B3").Value 
ArchiveScript MySource01, MyDestination01 
 
End Sub 
Sub ArchiveScript(MySource01, MyDestination01) 
Dim fSource As String, fDest As String 
Dim strDir As String, strName As String 
 
On Error Resume Next 
strDir = MyDestination01 
If Dir(strDir) = "" Then MkDir strDir 
On Error GoTo 0 
 
If Right(MySource01, 1) <> "\" Then MySource01 = MySource01 & "\" 
If Right(MyDestination01, 1) <> "\" Then MyDestination01 = MyDestination01 & "\" 
 
fDest = Dir(MyDestination01 & "*.*") 
 
On Error Resume Next 
Do While Len(fDest) 
Kill MyDestination01 & fDest 
fDest = Dir 
Loop 
On Error GoTo 0 
 
fSource = Dir(MySource01 & "*.*") 
 
Do While Len(fSource) > 0 
FileCopy MySource01 & fSource, MyDestination01 & fSource 
fSource = Dir 
Loop 
 
MsgBox "Opération terminée, Bonne journée !" 
Unload Me 
End Sub

Quelqu'un peut-il m'aider ?

Un grnad merci par avance, j'ai cherché bien longtemps sans trouver...

[EvaristeGaloisBis]

ben pour ton truc si j'ai tout bien compris, il faut juste faire une boucle for.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton1_Click() 
Dim MySource01 As String 
Dim MyDestination01 As String 
dim iRow as long
dim iMaxRow as long
  with Sheets("Source")
    iMaxRow= .Range("A3").end(xldown).row
    for iRow=3 to iMaxRow    
      MySource01 = .Range("A" & iRow).Value 
      MyDestination01 = .Range("B" & iRow).Value 
      ArchiveScript MySource01, MyDestination01 
    next
  end with
End Sub

Ceci dit le code n'est pas super optimal et ne remonte pas les erreurs possibles.