Per eseguire questo codice di esempio, incollarlo nella sezione Dichiarazioni di un form contenente 1una TextBox (Text1), 2 CommandButton (Command1 e Command2), un Label (Label1).
Quando il file specificato in Text1 viene trovato la ricerca si ferma ed il percorso del file viene salvato nella variabile "Risultato".
Ho sudato freddo per farlo, e guai a chi mi dice che c'era un modo più facile! :P
PS : Quando si indica il nome del file bisogna scrivere anche l'estensione.
codice:Option Explicit Dim Risultato As String Private Sub Command1_Click() 'Avvia la ricerca Command2.Tag = "go" Command2.Enabled = True Command1.Enabled = False Call AllDrive End Sub Sub AllDrive() 'Cicla tutti i Drive del computer Dim fs, d, dc, s, n Set fs = CreateObject("Scripting.FileSystemObject") Set dc = fs.Drives For Each d In dc On Error Resume Next s = d.DriveLetter Call AllFolders(s & ":\") Next End Sub Sub AllFolders(folderspec) 'Cicla tutte le cartelle del Drive Dim fs, f, f1, s, sf Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(folderspec) Set sf = f.SubFolders For Each f1 In sf On Error Resume Next 'esce se interrotto dall'utente DoEvents If Command2.Tag = "stop" Then Label1.Caption = "" Command2.Enabled = False Exit Sub End If s = f1.Name 'scrive il percorso in cui si sta cercando Label1.Caption = folderspec & s Call AllFiles(folderspec & s) Call AllFolders(folderspec & s & "\") Next Command1.Enabled = True End Sub Sub AllFiles(folderspec2) 'cicla tutti i file della cartella Dim fs, f, f1, fc, s, StrFileName Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(folderspec2) Set fc = f.Files For Each f1 In fc On Error Resume Next StrFileName = f1.Name 'nome del file 'Attenzione ricerca la parola esatta con l'etsensione; If Dir(folderspec2 & "\" & Text1.Text) = StrFileName Then 'per cercare le parole simili usare questa riga: 'If Dir(folderspec2 & "\*" & TxtRicerca.Text & "*") = StrFileName Then 'Risultato della ricerca Risultato = folderspec2 & "\" & StrFileName End If Next End Sub Private Sub Command2_Click() 'Annulla l'perazione di ricerca If MsgBox("Interrompere?", vbQuestion + vbYesNo, "") = vbYes Then Command2.Tag = "stop" End If End Sub![]()


Rispondi quotando