Cerca cartella

Stato
Chiusa ad ulteriori risposte.

Cels

Utente abituale
4 Dicembre 2018
319
28
Excel 2016
11
Ciao a tutti,
vorrei condividere con voi una piccola chicca per la ricerca di qualsiasi cartella nel sistema.
Si scrive nella textbox la cartella da cercare, clic sul pulsante, nella listbox vengono caricati i file contenuti nella cartella, doppio click su un file e questa si apre.
Se può essere utile a qualcuno 🙂
Buona continuazione a tutti.
Visual Basic:
Private Sub CommandButton1_Click()
Me.ListBox1.Clear
LeggiTutto Me.TextBox1.Value
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim mShell As Object
If Me.ListBox1.ListCount = 0 Then Exit Sub
  With Me.ListBox1
    For i = 0 To .ListCount - 1
      If .Selected(i) Then
        Set mShell = CreateObject("Shell.Application")
        mFile = .List(i, 0)
        mShell.Open (mFile)
        Exit For
      End If
    Next
  End With
Set mShell = Nothing
End Sub

Sub LeggiTutto(ByVal MiaDir As String)
Dim mFile As String, mPath As String, nCartelle As Long, Cartelle() As String, i As Long
If Right(MiaDir, 1) <> "\" Then MiaDir = MiaDir & "\"
mFile = Dir(MiaDir & "*.*", vbDirectory)
While Len(mFile) <> 0
    If Left(mFile, 1) <> "." Then
        mPath = MiaDir & mFile
        If (GetAttr(mPath) And vbDirectory) = vbDirectory Then
            ReDim Preserve Cartelle(0 To nCartelle) As String
            Cartelle(nCartelle) = mPath
            nCartelle = nCartelle + 1
        Else
            Me.ListBox1.AddItem MiaDir & mFile
        End If
    End If
    mFile = Dir()
Wend
For i = 0 To nCartelle - 1
    LeggiTutto Cartelle(i)
Next i
End Sub
 

Allegati

Ultima modifica di un moderatore:
  • Like
Reactions: Rubik72

alfrimpa

VBA Expert
Supermoderatore
Expert
18 Dicembre 2015
20.011
1.713
66
Napoli
2013
383
Cels @Cels

Ti ringrazio per la condivisione.
 
  • Like
Reactions: Cels

Rubik72

Excel/VBA Expert
Supermoderatore
Expert
12 Dicembre 2015
5.750
183
47
Cosenza
Excel 2016
201
Cels @Cels grazie della condivisione. Soluzione ricorsiva molto interessante :applausi:
 
  • Like
Reactions: Cels

Cels

Utente abituale
4 Dicembre 2018
319
28
Excel 2016
11
Ringrazio chi ha modificato il thread mettendo il codice, è stata una mia piccola dimenticanza:confusostelle:scusate.
alfrimpa @alfrimpa e Rubik72 @Rubik72 di niente cappello_saluta
 

alfrimpa

VBA Expert
Supermoderatore
Expert
18 Dicembre 2015
20.011
1.713
66
Napoli
2013
383
No Cels @Cels è quanto meno doveroso ringraziare chi fa qualcosa senza chiedere nulla in cambio.

E poi si vede che sei una “tosta” Muoio_muoio
 
Stato
Chiusa ad ulteriori risposte.

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!