You are here:Home-Domande su Excel VBA e MACRO-Copiare il contenuto di una cartella in un’altra cartella.
Copiare il contenuto di una cartella in un’altra cartella.2021-05-10T18:25:52+02:00

Home Forum Domande su Excel VBA e MACRO Copiare il contenuto di una cartella in un’altra cartella.

Visualizzazione 4 filoni di risposte
  • Autore
    Post
    • AvatarMisterExcel
      Partecipante
        Post totali: 63

        Buon pomeriggio a tutti.
        Ho cercato in rete un codice che mi copi il contenuto di una cartella in un’altra cartella, ma non ho trovato nulla da poter adeguare alle mie esigenze. In pratica io lavoro su un file che si trova nel percorso C:\Programmi\Dati\pippo.xls. Durante il salvataggio copio il suddetto file in altre unità rimovibili collegate al pc nel percorso \\Dati\pippo.xls con questo codice che funziona perfettamente:

        Dim fs2, d2, dc2
        Set fs2 = CreateObject("Scripting.FileSystemObject")
        Set dc2 = fs2.Drives
        For Each d2 In dc2
        If d2.DriveType = 1 Then
        ActiveWorkbook.SaveCopyAs Filename:=d2 & "\Dati\pippo.xls"
        End If
        Next

        Io avrei bisogno di un codice che mi copi tutto il contenuto della Cartella “Dati” nelle altre Cartelle “Dati” che si trovano in altre unità. Chiarisco che gli altri file da copiare non sono di formato .xls, ma sono di formato pdf, word, jpeg, mp3, mp4, ecc.
        Grazie a chi saprà darmi una dritta.

        • Questo topic è stato modificato 1 mese fa da AvatarMisterExcel.
      • AvatarMisterExcel
        Partecipante
          Post totali: 63

          Sono riuscito a scrivere questo codice che copia il contenuto di una cartella che si trova sul desktop in una cartella che si trova in più memorie rimovibili collegate al pc:

           Sub Copia()
           Dim FSO As Object
              Dim FromPath As String
              Dim ToPath, ToPath1, ToPath2 As String
          
                  FromPath = "C:\Users\Pippo\Desktop\Dati"       'Cartella d'origine
                  ToPath = "E:\Dati"                             'Cartella di destinazione
                  ToPath1 = "F:\Dati"                            'Cartella di destinazione
                  ToPath2 = "G:\Dati"                            'Cartella di destinazione
                      If Right(FromPath, 1) = "\" Then
                          FromPath = Left(FromPath, Len(FromPath) - 1)
                      End If
          
                      If Right(ToPath, 1) = "\" Then
                          ToPath = Left(ToPath, Len(ToPath) - 1)
                      End If
                      If Right(ToPath1, 1) = "\" Then
                          ToPath1 = Left(ToPath1, Len(ToPath1) - 1)
                      End If
                      If Right(ToPath2, 1) = "\" Then
                          ToPath2 = Left(ToPath2, Len(ToPath2) - 1)
                      End If
          
                  Set FSO = CreateObject("scripting.filesystemobject")
          
                      If FSO.FolderExists(ToPath) = False Then
                          Exit Sub
                      End If
                  FSO.CopyFolder source:=FromPath, destination:=ToPath
                      
                      If FSO.FolderExists(ToPath1) = False Then
                          Exit Sub
                      End If
                  FSO.CopyFolder source:=FromPath, destination:=ToPath1
                      
                      If FSO.FolderExists(ToPath2) = False Then
                          Exit Sub
                      End If
                  FSO.CopyFolder source:=FromPath, destination:=ToPath2
               End Sub

          Io ho inserito di default le unità rimovibili E, F e G.
          E’ possibile dichiararle attraverso un array in modo da poter snellire il codice?
          Grazie

          • AvatarKris_9951
            Partecipante
              Post totali: 212

              Ciao MisterExcel,

              prova questa Macro.
              Non so se funziona perchè non l’ho testata.

              Sub Copia()
                  Dim FSO As Object
                  Dim FromPath As String
                  Dim x As Long
                  Dim percorsi() As Variant
              
                  FromPath = "C:\Users\Pippo\Desktop\Dati"       'Cartella d'origine
                  
                  percorsi = Array("E:\Dati", "F:\Dati", "G:\Dati")
                  
                  If Right(FromPath, 1) = "\" Then
                      FromPath = Left(FromPath, Len(FromPath) - 1)
                  End If
              
                  For x = LBound(percorsi) To UBound(percorsi)
                      If Right(percorsi(x), 1) = "\" Then
                          percorsi(x) = Left(percorsi(x), Len(percorsi(x)) - 1)
                      End If
              
                      Set FSO = CreateObject("scripting.filesystemobject")
              
                      If FSO.FolderExists(percorsi(x)) = False Then
                          Exit Sub
                      End If
                      FSO.CopyFolder Source:=FromPath, Destination:=percorsi(x)
                  Next x
                  
                  Set FSO = Nothing
                  Erase percorsi
              End Sub
          • AvatarMisterExcel
            Partecipante
              Post totali: 63

              Ciao Kris_9951,
              grazie per il tuo riscontro (come sempre).
              Il codice funziona parzialmente, nel senso che copia solo nella Cartella “Dati” nella unità E.
              Le cartelle “Dati” nelle unità F e G rimangono vuote.
              Sinceramente non so quale parte di codice andare a modificare.

            • AvatarMisterExcel
              Partecipante
                Post totali: 63

                Ok, ho risolto.
                Bastava cambiare la parte finale del codice in questo modo:

                x = x + 1
                 Next x
                    
                    Set FSO = Nothing
                    Erase percorsi

                Grazie per la tua dritta!
                Alla prossima.
                RISOLTO

              • AvatarKris_9951
                Partecipante
                  Post totali: 212

                  Errore proprio stupido 😓😓

                  Però l’avevo detto che non l’avevo testato 😂😂

                  Grazie per il riscontro.

                  Alla prox 👍

              Visualizzazione 4 filoni di risposte
              • Devi essere connesso per rispondere a questo topic.