Excel e gli applicativi Microsoft Office Sfida numero 1: elenco di file in cartelle e sottocartelle

Voto per la Sfida n.1

Scegli a chi dare il tuo voto di questa sfida (sondaggio attivo dal 17 al 20 Febbraio)

  • Luca7322.22%2 votes
  • Albatros22.22%2 votes
  • Vecchio Frac55.56%5 votes
  • Oscar0%0 votes
  • Marius440%0 votes
LoginRegistrati
Stai vedendo 25 articoli - dal 26 a 50 (di 50 totali)
  • Autore
    Articoli
  • #12987 Risposta

    vecchio frac
    Senior Moderator
      171 pts

      vecchio frac ha scritto:

      darmi il tempo di fare qualche breve commento tecnico

      Ritiro la mia intenzione di commentare i codici proposti, visto che sono in gioco pure io e visto che le votazioni sono in corso, non sarebbe giusto se il mio giudizio influenzasse l'opinione dei votanti. Ne riparleremo quindi più avanti 🙂

      #12988 Risposta

      vecchio frac
      Senior Moderator
        171 pts

        Oscar ha scritto:

        La mia proposta

        Oscar, grazie del contributo, ma è incompleto, rileggi il quesito e l'obiettivo (primo post di questa discussione).

        Prego comunque Admin di aggiungere Oscar all'elenco dei candidati per essere votato (o di abilitarmi a farlo).

        #12996 Risposta
        Oscar
        Oscar
        Partecipante
          11 pts

          Ciao vecchio frac si ho letto che deve elencare la lista del file di Excel , ho provato ma mi da errore credo che per me sia troppo difficile , ho studiato informatica quando c'era il Dos usavo Clipper il liguaggio è simile a vb  a scuola ero bravo ma è passato 30 anni e ricordo poco o quasi niente scusami tanto ma credo sia meglio se mi elimini dalla lista dei partecipanti grazie tanto

          #13000 Risposta

          vecchio frac
          Senior Moderator
            171 pts

            Ma va là, non pensare che sia troppo difficile, lo è se non ci provi 🙂

            Usa il DOS... è quello che abbiamo fatto tutti 😛

            La soluzione con Clipper sarebbe originalissima! pensa un po', l'integrazione VBA-Clipper 😀

            #13008 Risposta
            Marius44
            Marius44
            Moderatore
              36 pts

              Salve a tutti

              Concordo con Alfredo: anche se qualcosa di VBA conosco, il livello di questa sfida è piuttosto alto.

              Per non fare brutta figura mi astengo dal partecipare.

              Voglio, però, "regalarvi" una chicca: date uno sguardo al file allegato (in verità un po' datato ma attualissimo) e "scoprirete" chi è l'Autore.

               

              Ciao a tutti,

              Mario

              Allegati:
              You must be logged in to view attached files.
              #13010 Risposta
              albatros54
              albatros54
              Moderatore
                54 pts

                vecchio frac ha scritto:

                La seconda proposta di Albatros, da testare, sembra riuscirci, però si limita a un sottolivello di profondità

                In questi giorni ho studiato e  ho trovato la soluzione che posto, è una funzione che deve essere richiamata da una sub, che passa il percorso e un paramentro numerico, in piu  la funzione ha un parametro Opzionale.

                Il paramentro opzionale viene passato alla funzione dalla funzione stessa, è mi serve per saltare le righe di codice che mi cercano i file nella Dir principale.

                Il codice della funzione deve essere copiato in un modulo assieme alla sub che la richiama, una volta copiato, basta variare il path dentro la sub e sul foglio attivo avremmo i nomi dei file e di tutte le dir e sottodir.

                Sub listafile()
                
                   Call listaSubDir("C:\Users\Utente\Desktop\sfidavbaforum\", 1)
                
                End Sub
                
                
                Function listaSubDir(ByVal Source As String, ByVal riga As Long, Optional ByVal salta As Long) As String
                
                    Dim strLungFile As String
                    Dim objFSO As Object
                    Dim lngdestRow As Long
                    Dim strmFolder As String
                    Dim objmFolder As Object
                    Dim objmySubFolder As Object
                
                
                    Set objFSO = CreateObject("Scripting.FileSystemObject")
                    Set objmyFolder = objFSO.GetFolder(Source)
                    If salta >= 2 Then GoTo saltino
                    strLungFile = Dir(objmyFolder & "\*.xls*")
                    Do While Len(strLungFile) > 0
                        Cells(riga, 1).Value = objmyFolder & "\" & strLungFile
                        riga = riga + 1
                        strLungFile = Dir
                    Loop
                saltino:
                    For Each objmySubFolder In objmyFolder.subfolders
                        strLungFile = Dir(objmySubFolder & "\*.xls*")
                        Do While Len(strLungFile) > 0
                            Cells(riga, 1).Value = objmySubFolder & "\" & strLungFile
                            riga = riga + 1
                
                            strLungFile = Dir
                        Loop
                        listaSubDir = listaSubDir(objmySubFolder.Path, riga, 2)
                    Next
                
                End Function

                Rispondendo al nostro Admin, per quanto riguarda il nome delle dir che hanno degli spazi, si puo aggirare la sub inseguendo il consigli del post #12954 di VF

                 

                Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
                Sempre il mare, uomo libero, amerai!
                ( Charles Baudelaire )
                #13011 Risposta

                vecchio frac
                Senior Moderator
                  171 pts

                  Marius44 ha scritto:

                  e "scoprirete" chi è l'Autore.

                  Prima di aprire il link ho dato un'occhiata al codice e ho riconosciuto lo stile 🙂

                  Tu mi rendi troppo merito anche perchè è comunque una procedura ricorsiva.

                  Però tu Supermario per partecipare, tanto per, potevi farlo 😛

                  Le prossime sfide saranno più alla portata, questa era la prima così, per rompere il ghiaccio.

                  albatros54 ha scritto:

                  In questi giorni ho studiato

                  LOL

                  #13016 Risposta

                  vecchio frac
                  Senior Moderator
                    171 pts

                    Marius44 ha scritto:

                    Voglio, però, "regalarvi" una chicca

                    E in realtà oggi ne utilizzo una versione semplificata, magari la posterò qui dopo la chiusura della sfida 🙂

                    #13017 Risposta
                    patel
                    patel
                    Moderatore
                      43 pts

                      Si potrebbero anche organizzare 2 gironi, serie esperti e non in modo da dare spazio a tutti

                      #13020 Risposta
                      Marius44
                      Marius44
                      Moderatore
                        36 pts

                        Salve a tutti

                        Quando Vecchio Frac scrive: "Però tu Supermario per partecipare, tanto per, potevi farlo 😛" mi ha punto sul vivo e mi ha stimolato a "partecipare tanto per". Scusate eventuali strafalcioni (visto il poco tempo). Ecco il codice:

                        In Questa_Cartella_di_Lavoro

                        Private Sub Workbook_Open()
                          Call ElencaDisco
                          Range("B2:C2,F3:G10000").ClearContents
                        End Sub
                        

                        In un Modulo standard (la sub ElencaCartelleFiles e la sub SaveClose assegnate ai due pulsanti sul Foglio1)

                         

                        Option Explicit
                        Option Compare Text
                        
                        Sub SaveClose()
                        ActiveWorkbook.Close SaveChanges:=False
                        End Sub
                        
                        Sub ElencaDisco() 'elenco dischi fissi del pc
                        Dim i As Long
                        Dim Fs, d, dc
                        Set Fs = CreateObject("Scripting.FileSystemObject")
                        Set dc = Fs.Drives
                        For Each d In dc
                          i = i + 1
                          Foglio1.Cells(i + 2, 1) = d.driveletter
                          Foglio1.Cells(i + 2, 1).Font.ColorIndex = 43
                        Next
                        With Foglio1.Cells(2, 1)
                          .Select
                          With Selection.Validation
                            .Delete
                            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                              xlBetween, Formula1:="=" & "A3:A" & 2 + dc.Count
                          End With
                        End With
                        Set Fs = Nothing
                        Set d = Nothing
                        Set dc = Nothing
                        End Sub
                        
                        Sub ElencaCartelleFiles()
                        Dim C As Collection, F, XX, FF
                        Dim dk As String, st As String, nc As String, hp As String
                        Dim Folder As String, Folder2 As String, FolderX As String
                        
                        Dim i As Long, a As Long, b As Long, x As Integer
                        Range("F3:G10000").ClearContents
                        dk = [A2]: st = [B2]: nc = [C2]
                        
                        If dk = "" Then
                          MsgBox "Selezionare un Disco"
                          Exit Sub
                        End If
                        If st = "" Then
                          MsgBox "Selezionare un Settore"
                          Exit Sub
                        End If
                        If nc = "" Then
                          MsgBox "Indicare una Cartella"
                          Exit Sub
                        End If
                        
                        hp = Environ("HOMEPATH")
                        Folder = dk & ":" & hp & "\" & st & "\" & nc
                        a = 2
                        a = a + 1
                        Cells(a, 6) = nc
                        'scrive i file nella cartella principale
                        Set C = TrovaFilesIn((Folder))
                        For Each F In C
                          Cells(a, 7) = F
                          a = a + 1
                        Next
                        b = a
                        Set C = TrovaFoldersIn((Folder))
                        For Each F In C
                          If F <> "." And F <> ".." Then
                            Cells(a, 6) = F
                            a = a + 1
                          End If
                        Next F
                        Dim Cart2()
                        For i = b To a - 1
                          x = x + 1
                          ReDim Preserve Cart2(1 To x)
                          Cart2(x) = Cells(i, 6)
                        Next i
                        If x = 0 Then Exit Sub
                        Range(Cells(b, 6), Cells(a, 7)).ClearContents
                        a = a - x
                        For i = 1 To UBound(Cart2)
                          Cells(a, 6) = Cart2(i)
                          Folder2 = Folder & "\" & Cart2(i)
                          'vede se ci sono cartelle
                          Set C = TrovaFoldersIn2((Folder2))
                          a = a + 1
                          For Each F In C
                            If F <> "." And F <> ".." Then
                              Cells(a, 6) = F
                              a = a + 1
                              'elenca i files di ogni sub-cartella
                              FolderX = Folder2 & "\" & F
                              Set XX = TrovaFilesInX((FolderX))
                              a = a - 1
                              For Each FF In XX
                                Cells(a, 7) = FF
                                a = a + 1
                              Next FF
                            End If
                          Next F
                        Next i
                        a = a - 1
                        Set C = TrovaFilesIn2((Folder2))
                        For Each F In C
                          Cells(a, 7) = F
                          a = a + 1
                        Next
                        Cells(1, 5).Select
                        End Sub
                        
                        Function TrovaFilesIn(Folder As String) As Collection
                          Dim F As String
                          Set TrovaFilesIn = New Collection
                          F = Dir(Folder & "\*")
                          Do While F <> ""
                            TrovaFilesIn.Add F
                            F = Dir
                          Loop
                        End Function
                        
                        Function TrovaFoldersIn(Folder As String) As Collection
                          Dim F As String
                          Set TrovaFoldersIn = New Collection
                          F = Dir(Folder & "\*", vbDirectory)
                          Do While F <> ""
                            If GetAttr(Folder & "\" & F) And vbDirectory Then TrovaFoldersIn.Add F
                            F = Dir
                          Loop
                        End Function
                        
                        Function TrovaFilesIn2(Folder2 As String) As Collection
                          Dim F As String
                          Set TrovaFilesIn2 = New Collection
                          F = Dir(Folder2 & "\*")
                          Do While F <> ""
                            TrovaFilesIn2.Add F
                            F = Dir
                          Loop
                        End Function
                        
                        Function TrovaFoldersIn2(Folder2 As String) As Collection
                          Dim F As String
                          Set TrovaFoldersIn2 = New Collection
                          F = Dir(Folder2 & "\*", vbDirectory)
                          Do While F <> ""
                            If GetAttr(Folder2 & "\" & F) And vbDirectory Then TrovaFoldersIn2.Add F
                            F = Dir
                          Loop
                        End Function
                        
                        Function TrovaFilesInX(FolderX As String) As Collection
                          Dim F As String
                          Set TrovaFilesInX = New Collection
                          F = Dir(FolderX & "\*")
                          Do While F <> ""
                            TrovaFilesInX.Add F
                            F = Dir
                          Loop
                        End Function
                        
                        

                        All'inizio la macro elenca in A2 i dischi presente sul pc con una Convalida dati.

                        Ho inserito altra convalida in B2 per quanto attiene ai settori che ho limitato (ma possono essere implementati).

                        Ciao a tutti,

                        Mario

                         

                        PS - Non capisco perchè nel secondo codice Option Explicit abbia l'apice davanti. Ovvio che non deve esserci.

                         

                        Allegati:
                        You must be logged in to view attached files.
                        #13022 Risposta
                        albatros54
                        albatros54
                        Moderatore
                          54 pts

                          admin ha scritto:

                          Data Scadenza di presentazione nuove proposte alla sfida:  Domenica 17 Febbraio ore 12.00

                          Ciao Supermario,tempo scaduto!!!      

                           

                          Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
                          Sempre il mare, uomo libero, amerai!
                          ( Charles Baudelaire )
                          #13023 Risposta

                          admin
                          Amministratore del forum

                             albatros54 ha scritto:

                            Ciao Supermario,tempo scaduto!!!      

                            Giusto! Ma non vorrei ricevere un ricorso perchè non ho specificato il fuso orario di riferimento ... e considerato che nessuno ha ancora votato lo ammetterei alla sfida 🙂

                            #13025 Risposta

                            vecchio frac
                            Senior Moderator
                              171 pts

                              #13026 Risposta
                              patel
                              patel
                              Moderatore
                                43 pts

                                albatros54 ha scritto:
                                In questi giorni ho studiato e ho trovato la soluzione che posto....

                                Mi sembra che la tua soluzione usi la ricorsione che è vietata

                                #13027 Risposta
                                patel
                                patel
                                Moderatore
                                  43 pts

                                  Non riesco a far funzionare la soluz di Marius, cosa è il settore ?

                                  #13028 Risposta
                                  Marius44
                                  Marius44
                                  Moderatore
                                    36 pts

                                    Ciao

                                    Ho scritto: "Ho inserito altra convalida in B2 per quanto attiene ai settori che ho limitato (ma possono essere implementati)."

                                    Per Settore ho inteso alcune cartelle principali (Desktop, Documenti, ecc.) che ci sono in quasi tutti i pc. Se selezioni la cella B2 vedrai che compaiono i "settori" da me scelti (ma puoi cambiarli direttamente in Convalida).

                                     

                                    E' vero, come ha detto albatros54, sono arrivato "fuori tempo massimo" e il file andrebbe "aggiustato" un pochino. Comunque anche così "rattoppato" dovrebbe funzionare (a me va OK).

                                    Ciao,

                                    Mario

                                     

                                    #13029 Risposta

                                    vecchio frac
                                    Senior Moderator
                                      171 pts

                                      Ho votato ma che fatica! 😀 Ero proprio indeciso 😉

                                      #13031 Risposta

                                      Mirko
                                      Partecipante
                                        1 pt

                                        Ciao

                                        La gara è terminata, ormai posso solo indicare il vincitore   

                                        Allego un vecchio codice "2004" aggiornato per 64 bit

                                        Solo un paio di righe, da provare!

                                        Allegati:
                                        You must be logged in to view attached files.
                                        #13033 Risposta

                                        vecchio frac
                                        Senior Moderator
                                          171 pts

                                          E perchè non hai partecipato? 😀

                                          #13034 Risposta

                                          Mirko
                                          Partecipante
                                            1 pt

                                            Mi sono accorto solo ora che il tempo era scaduto.

                                            Il codice presenta un errore in Vba compilando con Debug  ,  non avrei partecipato comunque!

                                            #13131 Risposta

                                            admin
                                            Amministratore del forum

                                              Cari Amici, la prima sfida si è conclusa e sono lieto di comunicarvi che..

                                              THE WINNER IS...     Vecchio Frac     

                                              Congratulazioni a Vecchio Frac!   

                                              #13133 Risposta

                                              vecchio frac
                                              Senior Moderator
                                                171 pts

                                                Grazie ai miei sostenitori 😀 credo comunque che la vittoria sia un po' immeritata. Stasera farò un paio di considerazioni sulle proposte pervenute... intanto grazie di cuore a tutti, partecipanti e non, per aver accolto questa iniziativa.

                                                Ho già in cantiere la seconda sfida... sarà più semplice e stavolta Alfredo non potrà sottrarsi!   

                                                #13144 Risposta

                                                vecchio frac
                                                Senior Moderator
                                                  171 pts

                                                  Allora cari amici mi permetto un paio di considerazioni a chiusura di questa prima sfida 🙂

                                                  Il Premio "Ritorno al futuro" va a Mirko, che purtroppo è intervenuto a tempo scaduto. La sua proposta è interessante e centra l'obiettivo, rispetta il requisito iniziale di evitare la ricorsione, ma risente di un porting troppo massiccio ed evidente: scommetto che si tratta di codice scritto per VB o addirittura QB, perchè riconosco un certo stile di parcellizzare funzioni per scopi puntuali (alcune funzioni sembrano scritte in modo forzato o "antiquato", o sembrano scritte in sostituzione di altre già disponibili in VBA).
                                                  Se fosse stata proposta in termini comunque avrei votato per questa soluzione 🙂

                                                  A Oscar va il Premio "Vorrei ma non posto". La proposta di Oscar è purtroppo invalutabile perchè si ferma a una bozza senza affrontare il cuore del problema. Mi complimento comunque per aver trovato il coraggio di buttarsi nella mischia.

                                                  A Marius spetta il Premio "Green power", rispetta il requisito iniziale ma presenta qualche errore in fase di esecuzione che limita un pochino il campo di azione: indicare le cartelle corrente e precedente ("." e "..") provoca errore o malfunzionamento; visivamente attraente, produce purtroppo delle errate associazioni tra file e folders o manca la corretta indentazione. Si ferma a due livelli di profondità.

                                                  Albatros riceve il Premio "Du' is megl' che uàn". Tre proposte, la terza è irricevibile perchè pur essendo perfetta, tuttavia non rispetta il requisito iniziale (evitare la ricorsione). La prima ("listafilecartelle") utilizza dei GoTo che mi fanno storcere il naso 😀 e presenta il limite di mostrare a video con dei MsgBox i risultati (metodo poco pratico, poco efficiente). La procedura presenta degli aspetti lievemente macchinosi (occorre scrivere a mano in una inputbox il path da cui ricavare l'elenco dei folder), però (nota positiva) utilizza efficacemente lo stratagemma di ricorrere al supporto della shell per l'elenco delle cartelle e delle sottocartelle. La seconda proposta ("listafileinsottodir") è meglio perchè più efficiente, ma è una subroutine non parametrizzata e questo limita un po' l'azione perchè non permette interazione con l'utente e comunque si limita a un solo livello di profondità.

                                                  Luca infine (per il quale ho votato e che secondo me è il vincitore della sfida) riceve il Premio "Vado al massimo". Il cuore della procedura è l'utilizzo elegante e sfacciato della Shell (del resto è la stessa tecnica che ho utilizzato io). Trovo un po' terribile forzare l'inserimento di formule da codice quando si poteva generare a codice il risultato e inserirlo nelle colonne direttamente (senza lasciare delle formule che comunque vengono sempre ricalcolate).
                                                  E' stata necessaria un piccola correzione per fargli accettare gli spazi nei folder. Per il resto funziona bene.

                                                  Nota finale. Tutte le soluzioni sono valide e vanno adattate al proprio contesto, non formulo giudizi di idoneità tecnica perchè non sono adatto: le mie considerazioni non sono giudizi di valore ma opinioni personali. Però mi piace assegnare premi 😀
                                                  A.i.v.!

                                                  #13147 Risposta
                                                  patel
                                                  patel
                                                  Moderatore
                                                    43 pts

                                                    Non vale ! a tutti un premio e a me niente per aver proposto la prima sfida  

                                                    #13148 Risposta

                                                    vecchio frac
                                                    Senior Moderator
                                                      171 pts

                                                      Caspita patel hai ragione! A te il premio "Archimede pitagorico" per aver escogitato una sfida complessa e articolata 😀

                                                    LoginRegistrati
                                                    Stai vedendo 25 articoli - dal 26 a 50 (di 50 totali)
                                                    Rispondi a: Sfida numero 1: elenco di file in cartelle e sottocartelle
                                                    Gli allegati sono permessi solo ad utenti REGISTRATI
                                                    Le tue informazioni:



                                                    vecchio frac - 2750 risposte

                                                    patel
                                                    patel - 1089 risposte

                                                    albatros54
                                                    albatros54 - 1062 risposte

                                                    Marius44
                                                    Marius44 - 1000 risposte

                                                    Luca73
                                                    Luca73 - 798 risposte