Copier dossiers depuis cellules excel + progressbar

Question

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...

flo127 · Answer

upppppppppppp

cs_pacadebord · Answer

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

flo127 · Answer

Super merci !!
De mon coté je vais tester :)

cs_pacadebord · Answer

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

flo127 · Answer

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

cs_pacadebord · Answer

Il faut supprimer les dernières lignes (Msgbox et unload) dans ta Sub ArchiveScript.

Pac

flo127 · Answer

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 ...

cs_pacadebord · Answer

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

Copier dossiers depuis cellules excel + progressbar

8 réponses

Votre réponse

Discussions similaires