ricerca file anche nelle sottocartelle

[deniel69]

Buon giorno,

Con il codice seguente riesco a cercare il nome di un file all'interno di una directori ma non nelle sottocartelle.
Come devo modificarlo per effettuare la ricerca anche nelle sottocartelle?
Excel 2007!

Codice: Seleziona tutto

Sub CercaFile()
'Cerco il file in una Dir specifica
'Creo HyperLink e volendo apro il file

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
Dim sPath As String
Dim nameDIS As String
Dim pdf As Long
Dim Ext As String
Dim strPDF_File_Name As String

nameDIS = ActiveCell.Value 'Range("A1").Value
sPath = "C:\draw\"
Ext = ".pdf"

      If Dir(sPath & nameDIS & Ext) <> "" Then
           'Inserisco HyperLink
            ActiveCell.Offset(0, 2).Select
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=sPath & nameDIS & Ext, TextToDisplay:= _
            nameDIS & Ext
           'Apro il file
            'strPDF_File_Name = "\\srvfs01.ad.orange1.eu\so1-to-draw\" & nameDIS & ".pdf"
            'ActiveWorkbook.FollowHyperlink strPDF_File_Name

        Else
           'Messaggio in caso non sia presente
            MsgBox ("Il disegno " & nameDIS & " non è presente nella cartella")
            Application.SendKeys "^{Q}~", False
           
      End If

End Sub


Grazie a tutti........

[Anthony47]

Usa questa funzione che restituisce il percorso + nome di un file, cercandolo in una directory e sue sottodirectories:

Codice: Seleziona tutto

Dim myFso As Object, fFile As String

Function FileFinder(ByVal StarPath As String, ByVal lFor As String) As String
Dim UB As Long, mySF As Object
'
'Restituisce il percorso completo del file, se presente
'
'   StarPath: il percorso da cui cominciare la ricerca, es "C:\Prova"
'   lFor: il file da cercare, es "pippo.jpg"
'
If myFso Is Nothing Then
    Set myFso = CreateObject("Scripting.FileSystemObject")
End If
If Right(StarPath, 1) <> Application.PathSeparator Then StarPath = StarPath & Application.PathSeparator
'
If myFso.FileExists(StarPath & lFor) Then
    fFile = StarPath & lFor
    FileFinder = fFile
    Exit Function
Else
    For Each mySF In myFso.GetFolder(StarPath).SubFolders
        If fFile <> "" Then
            FileFinder = fFile
            Exit Function
        End If
        Call FileFinder(mySF.Path, lFor)
    Next mySF
End If
End Function

Va messa in testa nello stesso modulo in cui hai inserito la tua Sub CercaFile, in modo che la dichiarazione iniziale sia in testa al modulo.
Restituisce il nome del PRIMO FILE che combacia.

Poi invece di usare If Dir(sPath & nameDIS & Ext) <> "" Then userai

Codice: Seleziona tutto

      fFile = ""
      If FileFinder(sPath, nameDIS & Ext) <> "" Then


Raccomando di NON CERCARE partendo dal solo drive (es D:) perche' potrebbero esserci dei percorsi vietati che manderebbero in errore il codice.

Fai sapere…

[deniel69]

Grazie mille,

Funziona tutto perfettamente, ho sostituito in inserimento HyperLink
"sPath & nameDIS & Ext," con "fFile," così tutto è corretto.

Grazie ancora............

[Anthony47]

"sPath & nameDIS & Ext," con "fFile," così tutto è corretto.

Era corretto anche prima, ma ora e' piu' lineare