Copier dossiers depuis cellules excel + progressbar

flo127 Messages postés 5 Date d'inscription mercredi 10 mars 2010 Statut Membre Dernière intervention 24 mars 2010 - 10 mars 2010 à 15:35
cs_pacadebord Messages postés 113 Date d'inscription lundi 31 mars 2003 Statut Membre Dernière intervention 19 décembre 2011 - 24 mars 2010 à 11:19
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]
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


[code]

Quelqu'un peut-il m'aider ?

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

8 réponses

flo127 Messages postés 5 Date d'inscription mercredi 10 mars 2010 Statut Membre Dernière intervention 24 mars 2010
23 mars 2010 à 09:41
upppppppppppp
0
cs_pacadebord Messages postés 113 Date d'inscription lundi 31 mars 2003 Statut Membre Dernière intervention 19 décembre 2011 2
23 mars 2010 à 17:40
Bonjour,

Alors dans l'ordre :

On pourrait dire je commence en cellule A2 et tant qu'il y a quelquechose dans la cellule et dans celle d'en dessous, je traite :

Private Sub CommandButton1_Click()
Dim MySource        As String
Dim MyDestination   As String
Dim laCellule       As Range

    Set laCellule = Worksheets("Source").Range("A2")
    
    Do While IsEmpty(laCellule.Value) = False
    
        MySource = laCellule.Value
        MyDestination = laCellule.Offset(0, 1).Value
        ArchiveScript MySource, MyDestination
        Set laCellule = laCellule.Offset(1, 0)
        
    Loop

    MsgBox "Opération terminée, Bonne journée !"
    Unload Me

End Sub


La copie du répertoire par fso ne permet pas facilement une progressbar car il faut gérer la copie fichier par fichier.

Il me semble qu'on peut se servir des api windows. Je regarde...

Pac
0
flo127 Messages postés 5 Date d'inscription mercredi 10 mars 2010 Statut Membre Dernière intervention 24 mars 2010
23 mars 2010 à 17:53
Super merci !!
De mon coté je vais tester :)
0
cs_pacadebord Messages postés 113 Date d'inscription lundi 31 mars 2003 Statut Membre Dernière intervention 19 décembre 2011 2
24 mars 2010 à 09:30
Quand on débute, les api ca pique un peu les yeux mais bon... tu pourrais te servir de l'api windows "SHFileOperation". Ou bien construire ton code avec FSO et une progressbar. Pas besoin d'estimer la taille, tu peux utiliser le nombre d'objets à déplacer.

Voilà, pas de problème mais que des solutions. Au boulot !

Pac
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
flo127 Messages postés 5 Date d'inscription mercredi 10 mars 2010 Statut Membre Dernière intervention 24 mars 2010
24 mars 2010 à 10:06
Bon pour la userform ca marche !! :) un grand merci
par contre il me met "opération terminée..." à chaque dossiers, comment faire pour qu'il n'apparaisse que lorsque tout est terminé ?


Pour la progress bar je regarde encore
0
cs_pacadebord Messages postés 113 Date d'inscription lundi 31 mars 2003 Statut Membre Dernière intervention 19 décembre 2011 2
24 mars 2010 à 10:12
Il faut supprimer les dernières lignes (Msgbox et unload) dans ta Sub ArchiveScript.

Pac
0
flo127 Messages postés 5 Date d'inscription mercredi 10 mars 2010 Statut Membre Dernière intervention 24 mars 2010
24 mars 2010 à 10:28
Niquel merci beaucoup !!

Pour la progressbar j'ai trouvé sur le net qu'on utiliser la SHfileOperation Function ou alors prendre 2 FileStream "un pour la source, un pour la destination (...) par paquets de 1 Mo

Qu'en pense tu ?
Par contre je seche sur comment faire le code du coup, si tu as des pistes ? car pour VBA je trouve casi tout le temps des trucs mais qui sont en lien avec des cellules et non des opérations de mouvement (du type copie). Et puisque la taille et le nombre de fichier sera variables ca fonctionne pas ...
0
cs_pacadebord Messages postés 113 Date d'inscription lundi 31 mars 2003 Statut Membre Dernière intervention 19 décembre 2011 2
24 mars 2010 à 11:19
Je ne connais pas le truc des filestream par paquet de 1 Mo

La copie de répertoire c'est pas spécialement du VBA, as-tu effectué une recherche de SHfileOperation sur ce site ?
Il y a un exemple ici.
Si tu sèches, je t'aiderai.

Pac
0