couper / coller les fichiers d'un dossier dans un autre dossier

[sangokudespieds]

Bonjour,


Je voudrais via une macro, couper/coller tous les fichiers d'un dossier nommé "archive" dans un autre dossier nommé par la valeur de la cellule A (texte) et la valeur de la cellule B (date)depuis une feuille ouverte d'un classeur.

 

[MJ13]

Re : couper / coller les fichiers d'un dossier dans un autre dossier

Bonjour sangokudespieds

Regarde l'aide sur MoveFolder, méthode.

 

[JNP]

Re : couper / coller les fichiers d'un dossier dans un autre dossier

Bonjour Sangokudespieds et bienvenue, salut Michel 🙂,
J'aurais plutôt dis : MoveFile, méthode vu qu'il parle de déplacer des fichiers 🙄...
Une autre méthode un peu subtile est la méthode Name avec des chemins complets, type

Name "C:\archives\texte.txt" As "C:\classés\texte.txt"

et ne pas oublier de consulter CreateFolder, méthode, pour créer le fichier de départ 😛
Bonne journée 😎

 

[MJ13]

Re : couper / coller les fichiers d'un dossier dans un autre dossier

Re ,Bonjour Jean-Noël

couper/coller tous les fichiers d'un dossier nommé "archive" dans un autre dossier

Je ne connais pas MoveFolder, mais quand je lis cela, cela m'y a fait pensé quand j'ai cherché avec F1 sur move 😱.

Après, il faut voir si c'est réalisable. Si cela l'est, cela pourrait être intéressant 🙂.

 

[JNP]

Re : couper / coller les fichiers d'un dossier dans un autre dossier

Re 🙂,

Après, il faut voir si c'est réalisable. Si cela l'est, cela pourrait être intéressant 🙂.

C'est assez facilement réalisable, il suffit de d'utiliser un objet Dossier et un objet Fichier, vérifier si le dossier de destination existe, sinon le créer, puis pour chaque Fichier dans Dossier, passer par MoveFile pour le changer de dossier 😛...
Mais laissons notre ami faire ses premiers pas, et nous le soutiendrons ensuite 🙄...
Bon appétit 😎

 

[MJ13]

Re : couper / coller les fichiers d'un dossier dans un autre dossier

Re

Bon, avec ce lien vers le site de Ron, il y a des choses intéressantes.

Copy, Move and Delete files and folders

CopyFolder semble posé moins de problème que MoveFolder (j'ai de problèmes de permission refusée 😱).

 

[JNP]

Re : couper / coller les fichiers d'un dossier dans un autre dossier

Re 🙂,
Bon quitte à faire de l'archivage, une proposition qui devrait te plaire, Michel, à condition d'avoir un dossier Archives et un dossier Classées au même niveau, et de modifier le chemin en constante en conséquence 😛...

Sub Archivage()
Const Chemin As String = "C:\temp\"
Dim Dossier1 As Object, Dossier2 As Object, Fichier As Object, SousDossier As Object, CheminDossier As String
Dim Existe As Boolean, Comparaison As String
Set Dossier1 = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin & "Classées")
If Dossier1.SubFolders.Count = 0 Then
    CheminDossier = Chemin & "Classées\De 2011-01-01 à " & Format(Now(), "yyyy-mm-dd")
    MkDir CheminDossier
Else
    For Each SousDossier In Dossier1.SubFolders
        If Right(SousDossier.Name, 10) = Format(Now(), "yyyy-mm-dd") Then
            Existe = True
            CheminDossier = Chemin & "Classées\" & SousDossier.Name
            Exit For
        Else
            If Right(SousDossier.Name, 10) > Comparaison Then Comparaison = Right(SousDossier.Name, 10)
        End If
    Next
    If CheminDossier = "" Then CheminDossier = Chemin & "Classées\De " & Comparaison & " à " & Format(Now(), "yyyy-mm-dd")
    If Existe = False Then MkDir CheminDossier
End If
Set Dossier2 = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin & "Archives")
For Each Fichier In Dossier2.Files
Fichier.Move CheminDossier & "\" & Fichier.Name
Next
End Sub

A + 😎

 

[MJ13]

Re : couper / coller les fichiers d'un dossier dans un autre dossier

Re

Merci jean-Noël 🙂. Je ne sais si je pourrais utiliser ton code un jour (il faut que je le comprenne) 😱.

Sinon, voici un code que j'utilise pour faire des sauvegardes de mes fichiers sur DVD. L'intérêt est que je trie mes données par année, je crée le même dossier que le fichier d'origine avec l'année et si j'ai 20 Go, je peux faire 5 DVDs automatiquement qui se nommeront DVD1 ....DVD5. Ces données sont issues d'un TCD 🙂.

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
Public i As Double
Public NomSource, NomRep1, RepNomDest, ext As String

Private Sub CreationDossier(sNomRep As String)
'issu d'un code de KiKi29 de http://www.excel-downloads.com/forum/110203-cr-er-dossier-enregistrer-dedans.html
    'ChDrive "D"
    'Stop
    SHCreateDirectoryEx 0&, sNomRep, 0&
End Sub
Sub Lance_sauvegarde_Vers_C_DVD()
'
' Macro2 Macro
' Macro enregistrée le 18/01/2010 par MJ
'
Dim Rep As String

'Stop
'recherche=ligne() qui oit être mis en face de chaque DVD
'Range("A1").Select
 '   Cells.Find(What:="Total Général", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=2, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
'Cells.Find(What:="LIGNE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=2, SearchOrder:=1, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

ncact = ActiveCell.Column
nldeb = ActiveCell.Value
    Selection.End(xlDown).Select
nlfin = ActiveCell.Value
'NomRep1 = Cells(1, ncact - 2) & ":\" & Cells(nldeb, ncact - 2) & "\"
NomRep1 = Cells(1, 1) & ":\" & Cells(nldeb, ncact - 1) & "\"
'GoTo suite
'Création nom dossier

    For i = nldeb + 1 To nlfin
    Rep = NomRep1 & Cells(i, 1) & "\" & Mid(Cells(i, 2), 3, Len(Cells(i, 2)) - 2)
    CreationDossier Rep

    Next
    'Stop
suite:
    'Stop
    'A amléliorer si il y a
    For i = nldeb + 1 To nlfin
    copy_fich
    'On Error Resume Next
    'If Cells(i, 4) > 0 Then ext = Cells(2, 4): copy_fich
    'If Cells(i, 5) > 0 Then ext = Cells(2, 5): copy_fich
    'If Cells(i, 6) > 0 Then ext = Cells(2, 6): copy_fich
    Next
    'Stop
End Sub
Sub copy_fich()
 'Stop
 'On Error Resume Next
 On Error GoTo suite
NomSource = Cells(i, 2) & "\" & Cells(i, 3) ' & "." & ext
    
    RepNomDest = NomRep1 & Cells(i, 1) & Mid(Cells(i, 2), 3, Len(Cells(i, 2)) - 2) & "\" & Cells(i, 3) '& "." & ext
    FileCopy NomSource, RepNomDest
    GoTo suite2
suite:
Cells(i, 2).Font.Bold = True
Cells(i, 3).Font.Bold = True
suite2:

End Sub
Sub copy_fich_racine()
' Stop
'NomSource = Cells(i, 2) & "\" & Cells(i, 3) ' & "." & ext
    
    'RepNomDest = NomRep1 & Cells(i, 1) & Mid(Cells(i, 2), 3, Len(Cells(i, 2)) - 2) & "\" & Cells(i, 3) & "." & ext
    'FileCopy NomSource, RepNomDest
'Stop Attention choisir par inputbox par exemple (ou faire des options buttons sur la feuille)
NomSource = Cells(i, 2) & "\" & Cells(i, 3) ' & "." & ext
   'Copie avec la structure des dossiers
    'RepNomDest = NomRep1 & Cells(i, 1) & Mid(Cells(i, 2), 3, Len(Cells(i, 2)) - 2) & "\" & Cells(i, 3) & "." & ext
     'Faire un RepNomDest sans nom de dossier (pour les fichierss multimédia (atention aux doublons))
    RepNomDest = NomRep1 & "\" & Cells(i, 3) '& "." & ext
    FileCopy NomSource, RepNomDest
End Sub

 

[JNP]

Re : couper / coller les fichiers d'un dossier dans un autre dossier

Re 🙂,
Pour mon code, rien de compliqué, comme il faut bien commencer, la première fois, il vérifie s'il n'y a pas de dossier de sauvegarde et il le crée "De 2011-01-01 à " aujourd'hui. Pour les sauvegardes suivantes, il regarde s'il en existe une du jour, si oui, il continue d'archiver dans ce dossier, sinon, il crée un nouveau dossier avec la dernière date de sauvegarde jusqu'à aujourd'hui 😛...
Pour ton code, je ne sais pas si c'est vraiment intéressant de passer par Shell32.dll quand MkDir suffit, à moins qu'il y ait une subtilité du type "ne crée que s'il n'existe pas" 🙄...
Pour le reste, j'ai pas bien suivi où se faisait la répartition des fichiers, mais je me doute que ton TCD est fait à partir d'une extraction des noms de fichier, dates, etc. 😉.
A + 😎

 

[MJ13]

Re : couper / coller les fichiers d'un dossier dans un autre dossier

Re

Pour mon code, rien de compliqué, comme il faut bien commencer, la première fois, il vérifie s'il n'y a pas de dossier de sauvegarde et il le crée "De 2011-01-01 à " aujourd'hui. Pour les sauvegardes suivantes, il regarde s'il en existe une du jour, si oui, il continue d'archiver dans ce dossier, sinon, il crée un nouveau dossier avec la dernière date de sauvegarde jusqu'à aujourd'hui ...

C'est pour cela que c'est toujours difficile de reprendre des codes qu'on a pas fait 😱.

Pour ton code, je ne sais pas si c'est vraiment intéressant de passer par Shell32.dll quand MkDir suffit, à moins qu'il y ait une subtilité du type "ne crée que s'il n'existe pas" ...

SHCreateDirectoryEx 0&, sNomRep, 0&

L'intérêt du code de Kiki29, c'est qu'il te crée l'arborescence très rapidement (environ 2000 dossiers et sous dossiers en moins d'une minute).

Pour le reste, j'ai pas bien suivi où se faisait la répartition des fichiers, mais je me doute que ton TCD est fait à partir d'une extraction des noms de fichier, dates, etc. .

Tout à fait, mais bon il y a d'autres macros pour y arriver, le but ici c'est de voir le code pour créer le dossier et copier le fichier 🙂.

En fait tout est la:

NomSource = Cells(i, 2) & "\" & Cells(i, 3) ' & "." & ext
    
    RepNomDest = NomRep1 & Cells(i, 1) & Mid(Cells(i, 2), 3, Len(Cells(i, 2)) - 2) & "\" & Cells(i, 3) '& "." & ext
    FileCopy NomSource, RepNomDest

Bon Week-end 🙂.