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

Login Registrati
Stai vedendo 25 articoli - dal 1 a 25 (di 50 totali)
  • Autore
    Articoli
  • #12692 Score: 0 | Risposta

    vecchio frac
    Senior Moderator
      238 pts

      Questo è il primo quesito della nostra rinnovata serie  storica degli "esercizi" di qualche anno fa.

      A proporla è il nostro patel, che ha fatto pervenire il suggerimento alla mail della Redazione: lo ringraziamo per aver rotto il ghiaccio, quindi a lui spetta l'onore di inaugurare questo divertente e utile appuntamento!

      La sfida consiste in questo: "preparare il codice VBA che elenca una lista dei file Excel presenti in un folder e nei relativi subfolder senza usare funzioni ricorsive".

      Non è un compito insuperabile ma nemmeno impossibile, quindi fatevi sotto con i vostri contributi! Per rendere più accessibile la competizione, e permettere a tutti di pensarci adeguatamente, le proposte verranno accettate solo fra cinque giorni da adesso: quindi potrete pubblicare i vostri post a partire da giovedì 14 febbraio a partire dalle ore 16 . Questa discussione infatti verrà chiusa da ora e riaperta al momento giusto.

      Eventuali richieste di chiarimento potranno essere fatte in chat o direttamente alla mail della Redazione.

      La giuria sarà composta da patel, da me e dal nostro Admin, e il giudizio riguarderà in generale la bontà del prodotto in termini di efficienza del codice, tecnica utilizzata, adeguatezza, concisione. In caso di codice simile o equivalente a quello di un altro utente, verrà utilizzato il criterio cronologico in base alla data e all'ora della pubblicazione della risposta. Solo le risposte che arriveranno in questa discussione verranno prese in considerazione.

      Il vincitore avrà la soddisfazione di aver partecipato e di aver illustrato qualche tecnica magari nuova o interessante. Inoltre avrà l'onore di proporre la sfida successiva!

      Quindi pronti? ...via: cominciate a pensarci, ci rivediamo qui giovedì prossimo!

      Edit by VF: in "corso d'opera" è stato cambiato il criterio di giudizio, che viene affidato alla sovranità popolare mediante sondaggio 🙂

      #12909 Score: 0 | Risposta

      vecchio frac
      Senior Moderator
        238 pts

        Discussione riaperta, via con la pubblicazione delle proposte!   

        #12910 Score: 0 | Risposta

        Luca73
        Partecipante
          54 pts

          Ciao 

          tra un meeting a l'altro butto lì la mia soluzione in allegato il file cha la contiene

          Sub ElencaFIleExcelinFolder()
          '
          'by Luca73
          
          Dim Folder As String
          Dim Stringa01 As String
          Dim Stringa02 As String
          Dim Stringa03 As String
          Dim NomeFile As String
          Dim objShell
          Dim wbNew As Workbook
          Dim DestinationSheet As Worksheet
          
          Set DestinationSheet = ActiveSheet
          With DestinationSheet.Range("A5", "E" & Rows.Count)
              .ClearContents
          End With
          With Application.FileDialog(msoFileDialogFolderPicker)
              .AllowMultiSelect = False
              .Show
              If .SelectedItems.Count > 0 Then
                  Folder = .SelectedItems(1)
              Else
                  Exit Sub
              End If
          End With
          NomeFile = Application.UserName
          NomeFile = Replace(NomeFile, " ", "")
          NomeFile = "FDA_" & NomeFile & "_" & Format(Now, "yyyymmddhhmmss") & ".csv"
          Stringa01 = Folder & "\*.xls" '& provare con Stringa01 = Folder & "\*.xls " & Folder & "\*.xlsx" Folder & "\*.xlsm "
          Stringa02 = Folder & "\" & NomeFile
          Stringa03 = " /o:n /S /B /a:-d"
          Set objShell = CreateObject("Wscript.Shell")
          objShell.Run ("%comspec% /k dir " & Stringa01 & Stringa03 & " > " & Stringa02 & " & exit"), 1, True
          objShell = Null
          DestinationSheet.Range("A3").Formula = Folder
          Set wbNew = Workbooks.Open(Filename:=Stringa02)
              If Not wbNew Is Nothing Then
                  Range("A1").CurrentRegion.Offset(1, 0).Copy DestinationSheet.Range("A" & 5)
                wbNew.Close False
              End If
          Set wbNew = Nothing
          Kill (Stringa02)
          With DestinationSheet
              If .Range("A5") <> "" Then
                  .Range("B5").FormulaR1C1 = "=LEFT(RC[-1],IFERROR(SEARCH(""\"",RC[-1],LEN(R3C1)+2),SEARCH(""\"",RC[-1],LEN(R3C1)))-1)"
                  .Range("C5").FormulaR1C1 = "=RC[-1]=R3C1"
                  .Range("D5").FormulaR1C1 = "=IF(NOT(RC[-1]),RIGHT(RC[-2],LEN(RC[-2])-SEARCH(""\"",RC[-2],LEN(R3C1))),"""")"
                  .Range("E5").FormulaR1C1 = "=RIGHT(RC[-4],LEN(RC[-4])-LEN(RC[-3])-1)"
              End If
              .Range("B5:E5").Copy .Range(.Range("A5"), .Range("A" & Rows.Count).End(xlUp)).Offset(0, 1)
              
          End With
          End Sub
          Allegati:
          You must be logged in to view attached files.
          #12913 Score: 0 | Risposta

          vecchio frac
          Senior Moderator
            238 pts

            Azz congratulazioni ma ci metterò una settimana a interpretare tutto 😀

            #12916 Score: 0 | Risposta

            Luca73
            Partecipante
              54 pts

              Permetti una battuta....la base (il cuore) è DOS.... se hai buona memoria è semplice.

              Cioa Ciao

              e perdona la battuta....

              #12919 Score: 0 | Risposta

              vecchio frac
              Senior Moderator
                238 pts

                Eh ho visto furbacchione 😀 certo che capisco! Anche la mia soluzione usa questo trucco, ma è più scarna. 

                Comunque l'ho provata in fretta e non dà il risultato che mi aspetto, devo guardare con più calma, ora sto chiudendo.

                #12921 Score: 0 | Risposta

                albatros54
                Moderatore
                  81 pts

                  Queste sono le mie proposte:

                  Sub listafilecartelle()
                      Dim lngn As Long
                      Dim objcl As Variant
                      Dim varsplitta As Variant
                      Dim strlitta As String
                      Dim strdimmi As String
                      Dim strsubdirs As String
                      Dim strmess As String
                      On Error GoTo errore
                      strdimmi = InputBox("Es:c:\prova\provabis\", "Inserisci il precorso")    ' C:\Users\Utente\Desktop\sfidavbaforum\
                      If Len(strdimmi) = 0 Then
                          GoTo errore
                      End If
                      If IsNumeric(strdimmi) = True Then
                          GoTo errore
                      End If
                      strsubdirs = InputBox("inserire True, per subdir", , "false")
                  
                  
                  
                      If strsubdirs = True Then
                  
                          ' lngn = 1
                          For Each objcl In Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & strdimmi & " /b /a-d /s").stdout.readall, vbCrLf), ".")
                              varsplitta = Split(objcl, ".")
                              strlitta = varsplitta(UBound(varsplitta))
                              If strlitta = "xls" Or strlitta = "xlsm" Then
                                  '                Cells(lngn, 1) = objcl
                                  strmess = strmess & vbLf & objcl
                                  lngn = lngn + 1
                              End If
                          Next
                          MsgBox strmess, , "File trovati nella Dir e subDir"
                          Exit Sub
                      Else
                          'lngn = 1
                          For Each objcl In Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & strdimmi & " /b /a-d").stdout.readall, vbCrLf), ".")
                              varsplitta = Split(objcl, ".")
                              strlitta = varsplitta(UBound(varsplitta))
                              If strlitta = "xls" Or strlitta = "xlsm" Then
                                  '                Cells(lngn, 1) = objcl
                                  strmess = strmess & vbLf & objcl
                                  lngn = lngn + 1
                              End If
                          Next
                          MsgBox strmess, , "File trovati nella Dir Principale"
                      End If
                      Exit Sub
                  errore:
                      MsgBox "Errore: " & Err.Number & vbNewLine & _
                             "Descrizione dell'errore: " & Err.Description & _
                             vbNewLine & "Inserire un valore Stringa", _
                             vbInformation, "Gestione "
                      Exit Sub
                  
                  End Sub
                  

                  il codice non fa altro, con due Inputbox, di chiedere il percorso e se vogliamo controllare le sottoDir,
                  una volta inserito i dati, compaiono delle Msgbox , con i dati trovati.
                  Se vogliamo che questi vengano scritti nel foglio attivo basta DECOMMENTARE le righe COMMENTATE(Toglie l'apice ('))

                  La seconda proposta:

                  `Sub listafileinsottodir()
                      Dim strLungFile As String
                      Dim objFSO As Object
                      Dim lngdestRow As Long
                      Dim strmFolder As String
                      Dim objmainFolder As Object
                      Dim objmySubFolder As Object
                      Dim lngarow As Long
                  
                      lngarow = 1
                      Set objFSO = CreateObject("Scripting.FileSystemObject")
                      strmFolder = ThisWorkbook.path & "\"
                      Set objmainFolder = objFSO.GetFolder(strmFolder)
                      strLungFile = dir(strmFolder & "*.xls*")
                  
                      Do While Len(strLungFile) > 0
                          Cells(lngarow, 1).Value = strmFolder & strLungFile
                          lngarow = lngarow + 1
                          strLungFile = dir
                      Loop
                      For Each objmySubFolder In objmainFolder.subfolders
                          strLungFile = dir(objmySubFolder & "\*.xls*")
                          Do While Len(strLungFile) > 0
                              Cells(lngarow, 1).Value = objmySubFolder & "\" & strLungFile
                              lngarow = lngarow + 1
                              strLungFile = dir
                          Loop
                      Next
                  End Sub
                  `

                   

                  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 )
                  Allegati:
                  You must be logged in to view attached files.
                  #12926 Score: 0 | Risposta

                  alfrimpa
                  Partecipante
                    24 pts

                    Ciao a tutti.

                    Permettete se mi intrometto ma vorrei esprimere una considerazione.

                    A mio modo di vedere il livello di difficoltà delle “sfide” dovrebbe essere tale che vi possa partecipare il più vasto numero possibile di utenti in modo da stimolare la loro curiosità e quindi la voglia di partecipare alla “contesa”.

                    Con il livello di difficoltà del quesito proposto si rischia che vi partecipi solo il gruppo dei “soliti noti”; io stesso (che pure qualcosina di Vba la conosco) in questa “sfida” non avrei saputo neanche da che parte iniziare.

                    A mio avviso il “successo” di un quiz va prima misurato dal numero di utenti che vi partecipa e poi sulla bontà delle soluzioni proposte.

                    Non sarebbe stato meglio se si fosse iniziato con domande relativamente semplici per poi proseguire “alzando progressivamente l’asticella” delle difficoltà?

                    Il tutto detto, ovviamente, senza nessuna “polemica” ma con spirito costruttivo.

                    Alfredo

                    #12928 Score: 0 | Risposta

                    vecchio frac
                    Senior Moderator
                      238 pts

                      Ciao Alfri! Grazie della tua considerazione. Non ci credo che non sai da che parte cominciare 😀

                      Vorrei però che fosse chiaro e si tenesse presente che non si tratta di una competizione a premi, di un'olimpiade del programmatore, di una corsa a chi è più bravo o a chi ce l'ha più lungo (il codice :D)...

                      La difficoltà di un esercizio è comunque sempre relativa: dipende se qualche volta hai già affrontato il problema o se hai nel tuo bagaglio certi trucchi da sfoggiare. A essere sinceri non ho trovato il quesito insormontabile o così difficile, recentemente un utente aveva posto questa domanda in forum e si era arrivati pian piano a una soluzione, lo scopo di aver riesumato queste "sfide" è anche quello di fornire panoramiche nuove, codici inusuali, punti di vista alternativi ai soliti: perchè un principiante possa anche, perchè no? avere alla fine del buon codice da riutilizzare.

                      Vero, questo primo "esercizio" comporta un limite (non utilizzare la ricorsione) ma come vedi non è insuperabile, ci son già tre proposte di buon livello (e quando pubblicherò la mia, anche se fuori gara, vedrai quanto sarà semplice).

                      Ad ogni modo, son favorevolissimo ad ogni idea e ti invito, anzi ti esorto proprio, a inviarmi alla mail della redazione qualche buona idea da trasformare in una prossima sfida! 

                      Comunque grazie dell'intervento Alfri, sicuramente ci aiuterà a studiare quesiti più generali o alla portata di un pubblico più ampio! 

                      #12929 Score: 0 | Risposta

                      patel
                      Moderatore
                        50 pts

                        perché la tua fuori gara ? non si potrebbe dichiarare il vincitore tramite una votazione da parte di tutti i partecipanti ?

                        #12930 Score: 0 | Risposta

                        alfrimpa
                        Partecipante
                          24 pts

                          Io scritto nell’interesse del forum per sollecitare una platea più vasta di partecipanti.

                          Ripeto il rischio è che “a cantarsela e a suonarsela da solo” sia sempre il solito gruppo.

                          E poi non vorrei che il visitatore “occasionale” possa pensare: “ma il VBA è così complicato?”.

                          Poi fate come ritenete opportuno.

                          Alfredo

                          #12932 Score: 0 | Risposta

                          vecchio frac
                          Senior Moderator
                            238 pts

                            Bè dopotutto è un forum tecnico, no? si viene qui soprattutto per imparare. Quante cose ho appreso io spulciando codici altrui, che poi ho fatto miei! Il mondo VBA alla fine richiede quattro cose di base, padroneggi quelle e ti arrangi in modo decente. Ne aggiungi poche altre e sei già uno sviluppatore avanzato 🙂

                            Il visitatore occasionale pensa che VBA sia complicato? Se ne ha bisogno davvero si ferma e impara qualcosa 😛

                            #12933 Score: 0 | Risposta

                            vecchio frac
                            Senior Moderator
                              238 pts

                              patel ha scritto:

                              dichiarare il vincitore tramite una votazione da parte di tutti i partecipanti ?

                              Posso anche pubblicare la mia proposta ma preferirei una giuria fissa che valuti gli aspetti che ho citato in premessa. Se faccio parte della giuria non posso essere imparziale 🙂

                              Comunque possiamo stabilirlo di volta in volta... 

                              #12935 Score: 0 | Risposta

                              vecchio frac
                              Senior Moderator
                                238 pts

                                Comunque, per partecipare, ecco la mia proposta.  E' concettualmente identica alle altre soluzioni proposte da Luca e Albatros ma l'ho scarnificata e ridotta all'osso (e dimostra che sappiamo tutti bene cercare con Google 😀 )

                                Velocissima, funziona perfettamente e fa un lavoro utilissimo (la uso molto spesso in ufficio per u confronto tra file pervenuti e file che devono pervenire dai collaboratori).

                                E' un po' una furbata, cioè non utilizza direttamente VBA ma si appoggia al DOS, quindi non sono sicuro che sia davvero una soluzione meritevole. La seconda versione in puro VBA di Albatros è più in linea con l'argomento, ma si limita al primo livello di sottocartelle.

                                Option Explicit
                                
                                Function dirlist(p As String, Optional filt As String = "*.*", Optional subdirs As Boolean = False)
                                'es. "C:\Users\Franz\OneDrive\EXCEL\EXCELVBA\TEST\"
                                Const QUOTE = """"
                                Dim results As String
                                
                                    'mostra informazioni estese sui files contenuti in directory, sottodirectory,
                                    'senza informazioni di riepilogo, escludendo i nomi delle sottodirectory
                                    results = CreateObject("WScript.Shell").Exec("CMD /C DIR " & QUOTE & p & filt & QUOTE & IIf(subdirs, " /S", "") & " /B /A:-D").StdOut.ReadAll
                                    Debug.Print results
                                
                                    'inserisce i risultati in colonna A:
                                    'Dim v As Variant
                                    'v = Split(results, vbNewLine)
                                    'Range("A1").Resize(UBound(v), 1).Value = WorksheetFunction.Transpose(v)
                                
                                End Function
                                #12954 Score: 0 | Risposta

                                vecchio frac
                                Senior Moderator
                                  238 pts

                                  Allego un file fatto in fretta (come se fosse una giustificazione valida 😛 )

                                  Allegati:
                                  You must be logged in to view attached files.
                                  #12957 Score: 0 | Risposta

                                  patel
                                  Moderatore
                                    50 pts

                                    vecchio frac ha scritto:
                                    E' un po' una furbata, cioè non utilizza direttamente VBA ma si appoggia al DOS, quindi non sono sicuro che sia davvero una soluzione meritevole.

                                    Non credo si possa risolvere  il quesito (no ricorsione) senza ricorrere al DOS, però ben vengano le idee, anche la mia soluzione usa il dos, evito di mostrarla perché quella di VF è decisamente più concisa.

                                    #12958 Score: 0 | Risposta

                                    vecchio frac
                                    Senior Moderator
                                      238 pts

                                      patel ha scritto:

                                      Non credo si possa risolvere  il quesito (no ricorsione) senza ricorrere al DOS

                                      La seconda proposta di Albatros, da testare, sembra riuscirci, però si limita a un sottolivello di profondità. E' evidente che per n livelli occorrono n cicli Do e For Each annidati, il che rende l'esercizio solo puramente didattico, in quanto poco efficiente.

                                      Ma ribadisco l'origine ludica della faccenda 😀

                                      #12966 Score: 0 | Risposta

                                      admin
                                      Amministratore del forum

                                        To Play...  In alto al topic ho messo Form per votare.. ovviamente posso aggiungere nuovi partecipanti in qualsiasi momento!

                                        #12967 Score: 0 | Risposta

                                        vecchio frac
                                        Senior Moderator
                                          238 pts

                                          Caspita che operativo il nostro Admin       

                                          Tutti gli utenti registrati possono votare quindi forza buttatevi ... anche se per chiarezza dovreste darmi il tempo di fare qualche breve commento tecnico sulle proposte in gioco    

                                          #12971 Score: 0 | Risposta

                                          patel
                                          Moderatore
                                            50 pts

                                            admin ha scritto:

                                            To Play...  In alto al topic ho messo Form per votare.. ovviamente posso aggiungere nuovi partecipanti in qualsiasi momento!

                                            Se io voto oggi per VF e domani si aggiunge Pippo con una proposta migliore come faccio a votarlo ?

                                            #12973 Score: 0 | Risposta

                                            Luca73
                                            Partecipante
                                              54 pts

                                              @ VF mi spieghi 

                                              Comunque l'ho provata in fretta e non dà il risultato che mi aspetto,

                                              Ciao Luca

                                              #12975 Score: 0 | Risposta

                                              admin
                                              Amministratore del forum

                                                patel ha scritto:

                                                Se io voto oggi per VF e domani si aggiunge Pippo con una proposta migliore come faccio a votarlo

                                                Dobbiamo definire una data di "scadenza" per la partecipazione e poi apriamo il televoto 🙂

                                                 

                                                #12976 Score: 0 | Risposta

                                                vecchio frac
                                                Senior Moderator
                                                  238 pts

                                                  @luca: appena possibile scusami oggi pomeriggio non riesco!

                                                  @admin: giusto! stabilisci tu la data di scadenza (ormai credo che non avremo più molto movimento e comunque era una sfida di prova)

                                                  #12981 Score: 0 | Risposta

                                                  admin
                                                  Amministratore del forum

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

                                                    Il televoto sarà attivo da Domenica ore 12.00 a Mercoledì 20 Febbraio ore 12.00 🙂

                                                    #12985 Score: 0 | Risposta

                                                    Oscar
                                                    Partecipante
                                                      32 pts

                                                      La mia proposta

                                                      Private Sub CommandButton1_Click()
                                                          Dim Res As Long
                                                          Dim fd As FileDialog
                                                      With Application
                                                           Set fd = Application.FileDialog(msoFileDialogFolderPicker)
                                                      End With
                                                      With fd
                                                         Res = .Show
                                                      End With
                                                      End Sub
                                                      Allegati:
                                                      You must be logged in to view attached files.
                                                    Login Registrati
                                                    Stai vedendo 25 articoli - dal 1 a 25 (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: