klasör içinde dosya arama

[selim5534]

s.a arkadaşlar birkaç sorum olacak size kodu yazdıgımda d sürücüsündeki müşteri klasörünü bulmuyor bir bakabilirmisiniz masaüstündeki dosyaları buluyor. bir diğere sorum ise dosya ismindeki uzantıyı nasıl gizleye biliriz. teeşkkürler
kod asagıdadır. teşekkürler



Private Sub Worksheet_Change(ByVal Target As Range)
Dim fso As Object, aranan, yol As String, kls As Object
If Not Intersect(Target, [D1]) Is Nothing Then
If Target.Value = "" Then Exit Sub

Set fso = CreateObject("scripting.filesystemobject")
yol = ThisWorkbook.Path & "\" '"D:\müşteri\"
Set kls = fso.getfolder(yol)
Sat = 2: Range("D21000").ClearContents
For Each aranan In kls.Files ' subfolders şeklinde olduğunda belirttiğiniz yol içerisinde klasör arar. Ama files yazarsanız klasör içerisinde dosya arar.
If aranan.Name Like "*" & Target.Value & "*" Then
Range("D" & Sat).Value = aranan.Name
Range("D" & Sat).Hyperlinks.Add Anchor:=Range("D" & Sat), Address:=aranan.Name
Sat = Sat + 1
End If
Next aranan
If Sat = 2 Then
MsgBox "Aranan değer bulunamadı...", vbInformation, "ASKM"
Else
MsgBox Sat - 2 & " adet belge bulundu...", vbInformation, "ASKM"
End If
End If
End Sub

 

[askm]

Dosyanız masaüstünde ise masaüstündeki dosyayı bulur.
yol = ThisWorkbook.Path & "\" '"D:\müşteri\" ifadesini
yol = "D:\müşteri\" olarak değiştirin.