› Excel e gli applicativi Microsoft Office › Sfida numero 1: elenco di file in cartelle e sottocartelle
-
AutoreArticoli
-
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 🙂
Discussione riaperta, via con la pubblicazione delle proposte!
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.Azz congratulazioni ma ci metterò una settimana a interpretare tutto 😀
Permetti una battuta....la base (il cuore) è DOS.... se hai buona memoria è semplice.
Cioa Ciao
e perdona la battuta....
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.
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.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
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!
perché la tua fuori gara ? non si potrebbe dichiarare il vincitore tramite una votazione da parte di tutti i partecipanti ?
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
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 😛
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...
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
Allego un file fatto in fretta (come se fosse una giustificazione valida 😛 )
Allegati:
You must be logged in to view attached files.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.
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 😀
To Play... In alto al topic ho messo Form per votare.. ovviamente posso aggiungere nuovi partecipanti in qualsiasi momento!
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
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 ?
@ VF mi spieghi
Comunque l'ho provata in fretta e non dà il risultato che mi aspetto,
Ciao Luca
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 🙂
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 🙂
-
AutoreArticoli