Trova files date le estensioni

Hai un problema con Excel?

Nuova discussione

Trova files date le estensioni
di marxitpa (utente non iscritto) data: 09/10/2013 11:39:25
Con la seguente macro ottengo l'elenco dei files a partire dal percorso indicato in A1 (incluse sottodirectory) (es. C:Documenti) e che hanno estensione assegnata (es. jpg) in B1.
Faccio tre richieste:
1) Nella colonna E compaia la dimensione del file;
2) Se in B1 si inseriscono più estensioni dei file da cercare separate da virgola (es: jpg, GIF, PNG, BMP) trovare i files con tutte le estensioni indicate?;
3) Se in A1, dopo la prima scansione, si inserisce un nuovo percorso, i file trovati proseguino l'elenco precedente.

Grazie

Sub Trova()
Dim R, Percorso, Ricerca
Percorso = Range("A1") ' in A1 inserire da dove deve iniziare la ricerca es. CDocumenti
Ricerca = Range("B1")  ' In B1 inserire l'estensione dei file da cercare es: pdf
Columns("A:E").ClearContents
Range("A1") = Percorso
Range("B1") = Ricerca
With Application.FileSearch
.LookIn = Percorso
.SearchSubFolders = True
.Filename = Ricerca
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
Range("F1") = "sono stati trovati " & .FoundFiles.Count & " file(s)"
For R = 1 To .FoundFiles.Count
Cells(R + 1, 6) = .FoundFiles(R)
Percorso = .FoundFiles(R)

NomeFile = Right(Percorso, Len(Percorso) - InStrRev(Percorso, ""))
Nomepercorso = Left(Percorso, Len(Percorso) - Len(NomeFile) - 1)
Cells(R + 1, 3) = Nomepercorso
Cells(R + 1, 4) = NomeFile

Next
Else
MsgBox "Nessun file trovato"
End If
End With
End Sub

di Grograman (utente non iscritto) data: 09/10/2013 11:56:05
Ciao!

Anche per te un esempio da provare, smontare ed adattare

Private Sub Sfoglia_Files()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' ATTENZIONE RICHIEDE L'ATTIVAZIONE DELLA LIBRERIA MICROSOFT SCRIPTING RUNTIME '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Per l'attivazione andare su "Strumenti", "Riferimenti", cercare e spuntare il nome ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim strPath As String
   
    Dim fd As FileDialog
    Dim objfd As Variant
    
    Dim objFSY As FileSystemObject
    Dim objFOL As Folder
    Dim objFIL As File
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .InitialFileName = "C:"
        .Title = "Sfoglia cartelle"
        .ButtonName = "Ok"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .Show
        For Each objfd In .SelectedItems
            strPath = objfd
        Next objfd
    End With
    
    If strPath = "" Then GoTo Uscita
    
    Set objFSY = New FileSystemObject
    Set objFOL = objFSY.GetFolder(strPath)
    
    For Each objFIL In objFOL.Files
      Debug.Print "NOME: " & objFIL.Name, "DIMENSIONE: "; objFIL.Size & " Byte" 'o altre azioni da fare sui files
    Next
Uscita:
    Set objFSY = Nothing
    Set objFOL = Nothing
    Set fd = Nothing
End Sub

di marxitpa (utente non iscritto) data: 09/10/2013 15:36:13
mi spiace, ma anche dopo l'attivazione della libreria, non vedo la macro.
Io utilizzo excel 2002.
di Vecchio Frac data: 09/10/2013 15:38:12
Non la vedi perchè è stata dichiarata "Private".
Dichiarala "Public" (oppure ometti la direttiva) e inserisci il codice in un modulo.
Sono certo che così la troverai ^_^
Public Sub Sfoglia_Files() 'oppure semplicemente Sub Sfoglia_Files()
di Grograman (utente non iscritto) data: 09/10/2013 15:54:05
Ma sopratutto, se non hai visto la macro non vedrai nemmeno quello che fa ;)

Lanciala dall'editor VBA non dal foglio excel.
Debug.Print
di marxitpa data: 09/10/2013 15:56:23
Grazie Vecchio Frac, adesso la trovo.
Grograman, sfoglio le directory, seleziono ma ... ... dove memorizza i dati?
di Grograman (utente non iscritto) data: 09/10/2013 16:00:37
Dal file con la macro premi ALT+F11, poi premi CTRL+G e lancia la macro, nella "finestra immediata" riporta nome e dimenzione del file.
di marxitpa data: 09/10/2013 16:06:28
Intelligente la visione, ma io devo inserire le dimensioni nella colonna E per poter proseguire con altre elaborazioni.
di marxitpa data: 09/10/2013 16:21:42
Trovata la soluzione alla prima richiesta: Nella colonna E compaia la dimensione del file.
Cerco suggerimenti per altre due richieste:
2) Se in B1 si inseriscono più estensioni dei file da cercare separate da virgola (es: jpg, GIF, PNG, BMP) trovare i files con tutte le estensioni indicate?;
3) Se in A1, dopo la prima scansione, si inserisce un nuovo percorso, i file trovati proseguino l'elenco precedente.

Ho inserito:
Dimensioni = FileLen(Percorso) ' Restituisce la lunghezza del file (byte) Cells(R + 1, 5) = Dimensioni
di Grograman data: 09/10/2013 16:27:51
cit: "Trovata la soluzione alla prima richiesta"

E una è andata

Ora altro suggerimento per il punto 2, partendo dal tuo codice, prova a metterlo la riga dopo in cui valorizzi la variabile "nomefile":
Select Case Right(nomefile, 4) Case Is = ".jpg", ".GIF", ".PNG", ".BMP" 'faccio l'analisi del file, dimensione ecc Case Else End Select
di marxitpa data: 09/10/2013 16:51:24
Grograman ... non me ne volere (non sono tanto esperto)
cito: 'Ora altro suggerimento per il punto 2, partendo dal tuo codice, prova a metterlo la riga dopo in cui valorizzi la variabile "nomefile":'
ho provato senza riuscirci.
Puoi darmi indicazioni più precise, dopo quale riga del mio codice devo inserire quanto da te indicato?
Ricordo che il riferimento è il contenuto in B1, pertanto il 'Case Is = ".jpg", ".GIF", ".PNG", ".BMP"' deve essere preso da B1.
di marxitpa data: 10/10/2013 10:28:04
Anche richiesta 2) 'Se in B1 si inseriscono più estensioni dei file da cercare separate da virgola (es: jpg, GIF, PNG, BMP) trovare i files con tutte le estensioni indicate?;'
... momentaneamente superata con "Convalida dati - Elenco". Di volta in volta seleziono l'estensione che interessa.
Ovviamente sono ben graditi miglioramenti all'interno del codice.

Ci lavoro e attendo contributo per ultimo quesito:
3) Se in A1, dopo la prima scansione, si inserisce un nuovo percorso, i file trovati proseguino l'elenco precedente.

di Luca.Donati data: 10/10/2013 15:39:48
Spero di non fare confusione, ma rovistando fra vecchi files di Excel 2003, ho trovato il codice qui sotto, cui cui facevo indici elaborati e completi di attributi vari (fra cui le dimensioni dei files).
Ovviamente lo avevo fatto con l'aiuto di diversi forum, tra cui, se ricordo bene, proprio questo.
Se può essere utile...

Sub dirdettagliata(cart, nome, este, confr)
'per Excel 2003
Dim objFSO As Object, objFile As Object
Dim finepath As String, altrofile As String
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = cart
.SearchSubFolders = True
.Filename = nome & "." & este
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
On Error Resume Next
questofile = .FoundFiles(i) 'nomefile
Set objFile = objFSO.GetFile(questofile)
finepath = Mid(objFile.Path, Len(cart) + 1, 300)
ActiveCell.Value = finepath
ActiveCell.Offset(0, 1).Value = objFile.Size 'dimensioni
ActiveCell.Offset(0, 2).Value = objFile.DateLastModified 'modifica
ActiveCell.Offset(0, 3).Value = GetAttr(objFile) 'attributo A
If confr <> 0 Then
    altrofile = Dir(confr & finepath)
    If altrofile = "" Then
    ActiveCell.Offset(0, 4).Value = "unico qui"
    End If
End If
ActiveCell.Offset(1, 0).Select
Next i
Else
MsgBox "File(s) non trovato."
End If
End With
Set fs = Nothing

End Sub

Sub finepath()
    inizioperc = Range("perc1").Value
    finepath = Mid(objFile.Path, Len(inizioperc) + 1, 300)
End Sub

Sub MyInfoFile_Gab53()
'dettagli di un file
    Dim objFSO As Object
    Dim objFile As Object, inizioperc As String, finepath As String
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(Range("A1").Value)
    inizioperc = Range("A2").Value
    finepath = Mid(objFile.Path, Len(inizioperc) + 1, 300)
    With Worksheets("Feuil1")
        .Range("A11").Value = "Data creazione: " & objFile.DateCreated
        .Range("A12").Value = "Data ultimo accesso: " & _
         objFile.DateLastAccessed
        .Range("A13").Value = "Data ultima modifica: " & _
         objFile.DateLastModified
        .Range("A14").Value = "Drive: " & objFile.Drive
        .Range("A15").Value = "Nome File: " & objFile.Name
        .Range("A16").Value = "Cartella - Sottocratella: " & objFile.ParentFolder
        .Range("A17").Value = "Path: " & objFile.Path
        .Range("A18").Value = "Nome abbreviato: " & objFile.ShortName
        .Range("A19").Value = "Path abbreviata: " & objFile.ShortPath
        .Range("A20").Value = "Dimensioni: " & objFile.Size
        .Range("A21").Value = "Tipo: " & objFile.Type
        .Range("A22").Value = "Attr.: " & GetAttr(objFile)
        .Range("A23").Value = "Fine percorso: " & finepath
    End With

End Sub

di marxitpa (utente non iscritto) data: 10/10/2013 17:04:46
grazie Luca.Donati, lo proverò.
Volevo segnalare che ho trovato soluzione anche al terzo quesito: "3) Se in A1, dopo la prima scansione, si inserisce un nuovo percorso, i file trovati proseguino l'elenco precedente."
=CONTA.VALORI della colonna D mi restituisce il numero delle celle non vuote;
La prima riga del nuovo elenco è quello successivo.

n.b.: è una procedura da 'dilettante' ... ma mi risolve il problema.
di marxitpa (utente non iscritto) data: 10/10/2013 19:42:17
ho ottenuto quanto cercavo.
Grazie a tutti.
di marxitpa data: 10/10/2013 19:43:18
di Paolo (utente non iscritto) data: 10/10/2013 21:38:31
Ciao marxitpa, non è che potresti allegare il file? Grazie in anticipo
di marxitpa data: 11/10/2013 03:15:15
ho allegato file .... da 'migliorare'.
Sono graditi suggerimenti e contributi migliorativi.
di Grograman data: 11/10/2013 08:46:04
cit: "Sono graditi suggerimenti e contributi migliorativi."

Quei 68 moduli sono proprio necessari?
Destro sul modulo, elimina, e snellisci il progetto

Mi metto all'opera di taglia e cuci!

di Grograman data: 11/10/2013 09:01:23
Intanto su exelexperts ho trovato una routine per eliminare quelli vuoti ;)

Me la segno tra gli appunti, ne vedo ancora un sacco con codice, ti consiglio di fare un pò di pulizia tu che conosci quelli che ti servono o meno.

Public Sub RemoveEmptyModules()
    'This CANNOT remove Sheet modules
    'Can remove Standard modules and Class modules only
    'For this to you should have the option "Trust access to the VBA project object model"
    'checked. This is under macro security.
    
    Dim objVbComponent      As Object
    Dim lngStartLine        As Long
    Dim lngLineCount        As Long
    Dim lngCntRemove        As Long
 
    Const ct_pp_none        As Long = 1
    Const ct_StdModule      As Long = 1
    Const ct_ClsModule      As Long = 2
 
    For Each objVbComponent In ActiveWorkbook.VBProject.VBComponents
        Select Case objVbComponent.Type
        Case ct_StdModule, ct_ClsModule
            lngStartLine = objVbComponent.CodeModule.CountOfDeclarationLines + 1
            lngLineCount = objVbComponent.CodeModule.CountOfLines
            If lngLineCount < lngStartLine Then
                ActiveWorkbook.VBProject.VBComponents.Remove objVbComponent
                lngCntRemove = lngCntRemove + 1
            End If
        End Select
    Next objVbComponent
    If lngCntRemove = 0 Then
        MsgBox "No empty modules present.", vbInformation, "Excel Experts Tip"
    Else
        MsgBox lngCntRemove & " empty module(s) removed.", vbInformation, "Excel Experts Tip"
    End If
 
    Set objVbComponent = Nothing
End Sub

di marxitpa (utente non iscritto) data: 11/10/2013 09:10:07
ma grazie ... vorrei tagliare anch'io ma non sono esperto e non vorrei creare danni.
Posso eliminare i moduli vuoti?

Non sapendo come fare ho utilizzato due macro simili (Trova [ricerca prima volta] e Trova2 [ricerche successive] per avere o non avere ' Columns("A:E").ClearContents ' o recuperare il numero di righe impegnate.
Come fare per unificare le due macro?

... mi spiace ma ... 'sono 'mbranato' ma, lo giuro, animato di buona volontà.
di marxitpa data: 11/10/2013 09:34:59
come suggerito da Grograman, ho preso in mano le forbici e zag, zag.
Ho allegato nuovo file ... sperando di non aver creato danni.
di Grograman data: 11/10/2013 10:10:06
Ti ho allegato un esempio, ce n'è di lavoro da fare, ma ho iniviato raggruppando le routine in un unico modulo, e sistemando quelle che ho visto come primo impatto.

Non mi è chiaro lo scopo del trova1 e trova2, quando e soprattutto per quali colonne vuoi eliminare i dati e quando invece vuoi accodarli a quelli esistenti.

Intanto prova quello e vedi se ti ci raccapezzi, purtroppo non ho tempo di commentarlo per bene, ci vorrebbe di più che a scriverlo :)

di Grograman data: 11/10/2013 10:17:08
Altro esempio, ma devo capire cosa esattamente vuoi ottenere.
La routine "Passo3", come mai c'è un 55 buttato lì, è un dato forfettario o è mirato?
Nell'esempio troverai " Range("A" & Rows.Count).End(xlUp).Row", cambiando quella "A" decidi su quale colonna vuoi trovare l'ultima riga piena e quindi fin dove mettere la formula.

QUESTO:
    Range("M2").Select
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[4]="""",IF(RC[5]="""","""",""*""),IF(RC[1]=R[-1]C[1],""*"",""""))"
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M55"), Type:=xlFillDefault
    Range("M2:M55").Select


SI PUO' RIASSUMERE IN:
Dim x As Long
x = Range("A" & Rows.Count).End(xlUp).Row
Range("M2:M" & x).FormulaR1C1 = "=IF(RC[4]="""",IF(RC[5]="""","""",""*""),IF(RC[1]=R[-1]C[1],""*"",""""))"

di marxitpa (utente non iscritto) data: 11/10/2013 10:58:58
cito 'La routine "Passo3", come mai c'è un 55 buttato lì, è un dato forfettario o è mirato?'
no, è forfettario (probabilmente evidenzia fino a dove ho selezionato in fase di creazione macro) ma deve riguardate tutta la colonna M e P per quanto sono i files presenti.

cito: Nell'esempio troverai " Range("A" & Rows.Count).End(xlUp).Row", cambiando quella "A" decidi su quale colonna vuoi trovare l'ultima riga piena e quindi fin dove mettere la formula.'
la colonna di riferimento può essere la D.

... ringrazio sempre per il prezioso contributo.
Se tutto funziona, la macro Finale (che raggruppa vari passaggi-macro) dovrebbe portare ad evidenziare con "*" la colonna M e riportare l'indirizzo dei file doppioni in P.
di Grograman (utente non iscritto) data: 11/10/2013 11:34:42
Domanda spot, ma lo scopo della macro è solo individuare i file doppi (ES: C:FilesFile1Pippo.jpg con C:FilesPippo.jpg) partendo da una cartella ed interrogandone le sottocartelle?
di marxitpa data: 11/10/2013 12:11:22
cit.: Domanda spot, ma lo scopo della macro è solo individuare i file doppi (ES: C:FilesFile1Pippo.jpg con C:FilesPippo.jpg) partendo da una cartella ed interrogandone le sottocartelle?

Sintetizzo-utilizzando excel voglio ottenere quanto segue:
1) elenco files presenti in uno o più percorsi (comprese sottodirectory) scelti.
se mi interessa continuo con:
2) mettere in ordine per nome e percorso evidenziando i doppioni.
2.1) dopo verifica, decidere di eliminare o, nel dubbio, spostare in una cartella prefissata.
2.2) mettere in ordine per dimensioni e tipo al fine di verificare se, pur avendo nomi diversi, non sono lo stesso documento (immagine in particolare).
n.b.: con macro lancia_file ho possibilità di lanciare il file esterno da verificare.

In parole povere, non utilizzando programmi già confezionati e molto validi, utilizzando solo excel ... fare 'pulizia' anche in HD esterni con dimensioni grosse.

sono 'inesperto', animato di tanta buona volontà e, essendo in pensione, ho da 'tenere in allenamento la testa'.

buona giornata.
di Grograman (utente non iscritto) data: 11/10/2013 16:05:34
Ciao!

Bhè intanto NON comprare programmi dedicati per fare quello che hai descritto, è tutto fattibile con VBA.

Il problema è che ci vuole il tempo per farlo

Io ad un progetto del genere non posso al momento dedicarmici, ma secondo me se ti sbatti e ti impegni ce la fai da solo!
Basta concentrarsi su un pezzetto alla volta
di marxitpa (utente non iscritto) data: 11/10/2013 16:43:11
grazie per l'incoraggiamento e buona serata ...

Vuoi Approfondire?