Sviluppare funzionalita su Microsoft Office con VBA Spostamento di file in una cartella di cui è nota solo una parte del nome

LoginRegistrati
Stai vedendo 10 articoli - dal 1 a 10 (di 10 totali)
  • Autore
    Articoli
  • #27505 Risposta

    Ghido
    Partecipante

      Ciao a tutti...

      sto cercando il sistema per spostare tutti i file contenuti in una cartella.

      La destinazione sarà un'altra cartella di cui conosco (a priori) solo la prima parte del nome (nel codice allegato è ipotizzato nella cella A1).

      Questa parte di stringa è comunque univoca, quindi, in via teorica, ("A1")&"*" dovrebbe individuare una ed una sola cartella... ma come posso farlo digerire a VBA?

      Grazie

      Sub MoveFile()
      
      '
      'Dichiarazione variabili
          Dim AllFile As String
          Dim FromPath As String
          Dim ToPath As String
          Dim FSO As Object
          
          AllFile = "C:\Users\lghidini\Downloads\*.*"
          FromPath = "C:\Users\lghidini\Downloads"
          ToPath = "\\NAS2000\Prog_Svil_Terr\settore pianificazione SIT\servizio pianificazione\Istruttorie paesaggistiche\- COMUNI NON IDONEI\" & Range("A1") & "*"
          Set FSO = CreateObject("scripting.filesystemobject")
             
      'Arresto per elementi mancanti
              If Len(Dir$(AllFile)) = 0 Then
                  MsgBox Prompt:="File mancanti.", Buttons:=vbCritical, Title:="Attenzione!"
                  Exit Sub
              End If
              
              If FSO.FolderExists(FromPath) = False Then
                  MsgBox FromPath & " non esiste!"
                  Exit Sub
              End If
              
              If FSO.FolderExists(ToPath) = False Then
                  MsgBox ToPath & " non esiste!"
                  Exit Sub
              End If
      
      'Copia dei file da Download alla cartella della pratica
          
          FSO.Copyfolder Source:=FromPath, Destination:=ToPath
      
      'Eliminazione file da Download
          If Len(Dir$(AllFile)) > 0 Then
              Kill AllFile
          End If
      
      End Sub
      
      

      Ghido

      #27533 Risposta

      GiuseppeMN
      Partecipante
        9 pts

        Buona sera, @ghido.

        @ghido, chiede:

        Spostamento di file in una cartella di cui è nota solo una parte del nome.

        Per quanto ne so non credo sia possibile intercettare una Cartella (Directory) senza il nome completo.
        Quello che posso proporti è la possibilità di scegliere dall'elenco delle Subdirectories all'interno di una Cartella la Cartella da inserire in Cella "A1".

        A disposizione.

        Giuseppe

        #27535 Risposta
        patel
        patel
        Moderatore
          40 pts

          l'asterisco non funziona con le cartelle

          #27541 Risposta

          Ghido
          Partecipante

            Ciao @giuseppemn

            grazie per il consiglio. ho provato a metterlo in pratica!

            Io sono decisamente un neofita, e quindi chiedo conferma a te... e agli altri esperti del forum sulla accettabilità del mio risultato, che ti riporto!

            Inoltre chiedo un'altra cosa: ho impostato .InitialFileName con il percorso da cui deve partire la ricerca. Che voi sappiate, in msoFileDialogFolderPicker è possibile impostare automaticamente anche un filtro di ricerca per le sottocartelle presenti nel percorso? (spesso devo ricercarla in un archivio di alcune migliaia)

            Grazie ancora per i preziosissimi consigli

            Sub MoveFile()
            
            '
            'Dichiarazione variabili
                Dim RootPath As String
                Dim CodPrat As String
                Dim FromPath As String
                Dim ToPath As String
                Dim AllFile As String
                Dim NewPath As String
                Dim DiaFile As FileDialog
                Dim FSO As Object
                
                RootPath = "C:\Users\lghidini\Desktop\"
                CodPrat = Range("A1").Value
                FromPath = RootPath & "\Prova"
                ToPath = RootPath & CodPrat
                AllFile = FromPath & "\*.*"
                Set FSO = CreateObject("scripting.filesystemobject")
            
            'Arresto per elementi mancanti
                    If Len(Dir$(AllFile)) = 0 Then
                        MsgBox Prompt:="File mancanti.", Buttons:=vbCritical, Title:="Attenzione!"
                        Exit Sub
                    End If
                    
                    If FSO.FolderExists(FromPath) = False Then
                        MsgBox FromPath & " non esiste!"
                        Exit Sub
                    End If
                    
            'Copia dei file da Download alla cartella della pratica
                    If FSO.FolderExists(ToPath) = True Then
                        FSO.Copyfolder Source:=FromPath, Destination:=ToPath
                    ElseIf FSO.FolderExists(ToPath) = False Then
                        Set DiaFile = Application.FileDialog(msoFileDialogFolderPicker)
                        With DiaFile
                            .Title = "Seleziona nuovo percorso"
                            .InitialFileName = "C:\Users\lghidini\Desktop\"
                            .AllowMultiSelect = False
                            .Show
                        End With
                        If DiaFile.SelectedItems.Count > 0 Then
                            NewPath = DiaFile.SelectedItems(1)
                            FSO.Copyfolder Source:=FromPath, Destination:=NewPath
                            ElseIf DiaFile.SelectedItems.Count = 0 Then
                            MsgBox Prompt:="Nessun percorso selezionato", Buttons:=vbCritical, Title:="Attenzione!"
                            Exit Sub
                        End If
                    End If
            
            'Eliminazione file da Download
                If Len(Dir$(AllFile)) > 0 Then
                    Kill AllFile
                End If
            
            End Sub
            
            

             

             

             

             

            #27543 Risposta

            GiuseppeMN
            Partecipante
              9 pts

              Buon pomeriggio @ghido;
              credo dovrò analizzare meglio il tuo Codice VBA, da un primo sguardo mi sembra ci sia qualche cosa che non mi convince.
              Il Codice che ho impostato, solo per la scelta della Cartella di destinazione scelta è:

              Option Explicit
              
              Sub cerca_file_da_caricare()
              Dim fd As FileDialog
              Dim percorso As Variant
              Dim cartella As String
              
              Set fd = Application.FileDialog(msoFileDialogFolderPicker)
              With fd
              .InitialFileName = "C:\Users\lghidini\Desktop\"
              .Title = "Sfoglia cartelle"
              .ButtonName = "OK"
              .AllowMultiSelect = False
              .InitialView = msoFileDialogViewDetails
              .Show
              For Each percorso In .SelectedItems
              cartella = percorso
              Next
              End With
              Cells(1, 1).Value = cartella
              End Sub

              Appena posso cerco di adattalo alla tua richiesta ma temo dovrò rimadare l'analisi a domani.

               

              Giuseppe

              #27555 Risposta

              Giuseppe

                Buona giornata, @ghido;
                nel tuo Codice VBA mi genera un errore in:
                FSO.CopyFolder Source:=FromPath, Destination:=NewPath
                Molto probabilmente manca l'estensione dei File da spostare; in ogni caso, perdonami, ho preferito riscrivere il Codice completo.

                Option Explicit
                
                Sub Sposta_Files()
                On Error GoTo 10
                Application.ScreenUpdating = False
                Const Origine As String = "C:\Prova" ' Cartella nella quale selezionare la Cartella di destinazione.
                Const Ext As String = "*.*" ' Dedinisce l'estensione dei File da valutare.
                Dim Pth As String
                Dim DPth As String
                Dim Fd As FileDialog
                Dim Percorso As Variant
                Dim Cartella As String
                Dim FSO As Object
                
                Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
                With Fd
                .InitialFileName = Origine & "\"
                .Title = "Sfoglia cartelle"
                .ButtonName = "OK"
                .AllowMultiSelect = False
                .InitialView = msoFileDialogViewDetails
                .Show
                For Each Percorso In .SelectedItems
                Cartella = Percorso
                Next
                End With
                Cells(1, 1).Value = Cartella
                
                Pth = "C:\Prova\Nuovo\" ' NomeFile dal quale spostare i File
                DPth = Cells(1, 1).Value
                
                If Right(Pth, 1) <> "\" Then
                End If
                
                Set FSO = CreateObject("scripting.filesystemobject")
                
                If FSO.FolderExists(Pth) = False Then
                MsgBox Pth & " Non esiste"
                Exit Sub
                End If
                
                If FSO.FolderExists(DPth) = False Then
                MsgBox DPth & " Non esiste"
                Exit Sub
                End If
                
                FSO.CopyFile Source:=Pth & Ext, Destination:=DPth
                Kill Pth & "\*.*"
                MsgBox "File spostati da: " & Pth & " a: " & DPth
                Set Fd = Nothing
                Set FSO = Nothing
                End
                10:
                MsgBox "La Procedura non è andata a buon fine."
                Set Fd = Nothing
                Set FSO = Nothing
                Application.ScreenUpdating = True
                End Sub

                Il Codice è solo una bozza ma potrebbe essere uno spunto per migliorare la Procedura.
                Come puoi ben vedere ho utilizzato le Costanti:
                - Const Origine As String = "C:\Prova"
                e
                - Const Ext As String = "*.*"
                In questo modo puoi definire la Cartella nella quale selezionare la Cartella di destinazione e l'estensione dei Files da spostare.

                 

                Giuseppe

                #27556 Risposta

                Ghido
                Partecipante

                  Buongiorno @giuseppemn

                  grazie infinite per le dritte. Ho provato ad inserire il codice come parte di un'altra macro, e tutto funziona, ma se volessi tenerla come Sub a se stante, richiamandola all'interno di un'altra Sub, sarebbe possibile?
                  Cerco di schematizzarti qui sotto l'idea... e soprattutto il relativo problema: quando nella Sub CaricaFile riscontra un errore, vorrei che interrompesse sia la Sub secondaria sia quella principale, mentre, scritta così, interrompe solo la seconda e prosegue, ovviamente, con la prima!

                  Grazie di nuovo!!!

                  Sub Aggiorna()
                  '
                  'Prima parte di codice per aggiornamento dei dati di un Foglio
                  '....
                  
                      If Range("D23") <> "" Or Range("D35") <> "" Then
                          Call CaricaFile
                      End If
                          
                  'Seconda parte di codice per aggiornamento dei dati di un Foglio
                  '....
                          
                  End Sub
                  
                  Sub CaricaFile()
                  
                  'Il codice per lo spostamento dei file (di cui ai messaggi precedenti)
                  'comprensivo di criteri di arresto in caso di elementi mancanti (ad es...
                              If Len(Dir$(AllFile)) = 0 Then
                                  MsgBox Prompt:="File mancanti.", Buttons:=vbCritical, Title:="Attenzione!"
                                  Exit Sub
                              End If
                  
                  '... e il resto del codice di spostamento
                  
                  End Sub
                  #27558 Risposta

                  Giuseppe

                    Buona giornata, @ghido;
                    non mi è molto chiara la tua richiesta e senza un dialogo diretto credo veramente complicato cercare di risolvere.
                    Considera che dopo le ultime modifiche alla struttura di Forum ho dovuto inviare tre risposte prima di vedere concretizzarsi la mia proposta.

                    Credo mi fermerò qui ma ti lascio in buone anzi ottime mani.

                     

                    Giuseppe

                     

                    #27561 Risposta

                    Ghido
                    Partecipante

                      Grazie infinite @giuseppemn...

                      probabilmente stavamo scrivendo contemporaneamente (per questo nel mio ultimo codice è richiamato un criterio di arresto superato dal tuo più raffinato "On Error GoTo 10"...

                      Forse questo potrebbe risolvere anche il problema del Call (ora ci provo).

                      Il tuo aiuto è stato preziosissimo!!!

                      Ghido

                      #27586 Risposta

                      Giuseppe

                        Buona giornata, @ghido;
                        anche a beneficio degli Utenti interessati a questa Discussione, consentimi solo una precisazione e un consiglio.

                        Precisazione, è opportuno chiudere le istanza aperte; quindi:

                        ...
                        ...
                        ...
                             MsgBox "File spostati da: " & Pth & " a: " & DPth
                        Set Fd = Nothing                      '  Modifica
                        Set FSO = Nothing                     '  Modifica
                        Application.ScreenUpdating = True     '  Modifica
                            End
                        10:
                            MsgBox "La Procedura non è andata a buon fine."
                        Set Fd = Nothing                      
                        Set FSO = Nothing                     
                        Application.ScreenUpdating = True     
                        End Sub

                         

                        Consiglio, sarebbe utile aggiungere in controllo:

                        ...
                        ...
                        ...
                        Cells(1, 1).Value = Cartella
                        
                        If Cartella = "" Or Cartella = Origine Then
                        MsgBox "È necessario scegliere una Cartella di destinazione valida."
                        Set Fd = Nothing
                        Application.ScreenUpdating = True
                        End
                        End If
                        ...
                        ...
                        ...

                        Questo controllo evita che in fase di selezione della Cartella di destinazione si prema il Pulsante "Annulla" oppure non venga selezionata alcuna Cartella.

                         

                        Giuseppe

                      LoginRegistrati
                      Stai vedendo 10 articoli - dal 1 a 10 (di 10 totali)
                      Rispondi a: Spostamento di file in una cartella di cui è nota solo una parte del nome
                      Gli allegati sono permessi solo ad utenti REGISTRATI
                      Le tue informazioni:



                      vecchio frac - 2750 risposte

                      albatros54
                      albatros54 - 1009 risposte

                      patel
                      patel - 976 risposte

                      Marius44
                      Marius44 - 839 risposte

                      Luca73
                      Luca73 - 717 risposte