.xls dosyalarını bulmak ?

[faruk59]

Arkadaslar ektekı dosya masaustunde bulunan excel dosyalarını userform uzerınde bulunan listboxta sıralıyor.Sıralanan dosyalara cift tıkladıgımda bu dosya acılıyor.Şimdi userform uzerıne bır textbox yerlestırdım bu textboxla lıstbox suzmek ıstıyorum yanı textboxa yazdıgım dosya ısmını ( ılk bırkac harfı uygun olanları ) listboxta gormek ıstıyorum Bunu nasıl yapabılırım eskı konularaaıt dosyalar sılındıgı ıcın yenı konu acmak zorunda kaldım . Şimdiden tesekkur ederım

 

[Orion1]

İçerir olacak şekilde düzenledim.Dosya ektedir.

Private Sub TextBox1_Change()
'Liste kutusuna Dosyaları sıralar
   Listtasinir.Clear
    ChDrive ("C:")
    yol = CreateObject("wscript.shell").SpecialFolders(10)
    ChDir yol
    dosya = Dir("*" & TextBox1.Text & "*.xls")
    While dosya <> ""
        Listtasinir.AddItem dosya
        dosya = Dir
    Wend
    'ChDir "C:\Belgelerim"
  'Worksheets("Giris").Select
End Sub

 

[faruk59]

çok tesekkur ettım ellerınıze saglık

 

[N.Ziya Hiçdurmaz]

yanıt

Klasörün hangi dizinde olduğu farketmez.

Private Sub CommandButton1_Click()
        If ListBox1.ListIndex < 0 Then
            MsgBox "Önce dosya seçmelisiniz.", vbInformation
            Exit Sub: End If
dosya = ListBox1
On Error Resume Next
isim = ListBox1
Workbooks.Open ThisWorkbook.Path & "\dosyalar\" & isim & ".xls"
Unload Me
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub TextBox1_Change()
Dim sat As Integer
On Error Resume Next
ListBox1.Clear
    For sat = 1 To Cells(65536, "a").End(xlUp).Row
        If Cells(sat, "a") Like TextBox1 & "*" Then
            ListBox1.AddItem
            ListBox1.List(s, 0) = Split(Cells(sat, "a"), ".")(0)
            s = s + 1
        End If
    Next
End Sub

Private Sub UserForm_Initialize()
Dim dosya As Variant
[a1:A65000] = Empty
Set dosyalar = CreateObject("Scripting.FileSystemObject")
yol = ThisWorkbook.Path
Set klasor = dosyalar.GetFolder("" & yol & "\dosyalar")
Set dongual = klasor.Files
For Each dosya In dongual
s = s + 1
Cells(s, 1) = dosya.Name
Next
'*****
TextBox1 = ".": TextBox1 = ""
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        If CloseMode = 0 Then Cancel = True
End Sub

 

[Orion1]

Şimdi ben size daha güzel bir kod yazıcam.Az sonra.,Bekleyin.

 

[faruk59]

Evren bey sıze bır sorum olacaktı oda su duzelttıgınız kod tam ıstedıgım gıbı olmus fakat dosyamın adı rakamsa sadece yanı 1.xls dıyelım textboxa 1 yazdıgım zaman suzme gerceklesmıyor bunu nasıl halledebılırz tesekkur ederım "N.Ziya beyın kodlaryla cozdum sorunumu gercekten ıkınızede tesekkur ederım

 

[Orion1]

Yalnız istediğim dosyayı filtreyelemedim.Bu özellik yok sanırım bu işlemde.
Ekli dosyayı inceleyiniz.

 

[Orion1]

Evren bey sıze bır sorum olacaktı oda su duzelttıgınız kod tam ıstedıgım gıbı olmus fakat dosyamın adı rakamsa sadece yanı 1.xls dıyelım textboxa 1 yazdıgım zaman suzme gerceklesmıyor bunu nasıl halledebılırz tesekkur ederım "N.Ziya beyın kodlaryla cozdum sorunumu gercekten ıkınızede tesekkur ederım

Dosyanızın double click olayındaki kodları yanlış yazmışsınız.Ondan kaynaklanıyor.Ben ona bakmamıştım.
Listbox'ın double_click olayındaki kodları aşağıdaki ile dğiştirin çalışacaktır.

Private Sub Listtasinir_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim yol As String
yol = CreateObject("wscript.shell").SpecialFolders(10)
Workbooks.Open (yol & "\" & (Listtasinir.Value))
End Sub

 

[Orion1]

İlk dosyadaki metodu değiştirdim.Ekteki dosyayı inceleyiniz.

Private Sub TextBox1_Change()
    yol = CreateObject("wscript.shell").SpecialFolders(10)
Listtasinir.Clear
    Set lst = CreateObject("Scripting.FileSystemObject").GetFolder(yol)
    For Each dosya In lst.Files
        If Right(dosya.Name, 4) = ".xls" Then
            If dosya.Name Like "*" & TextBox1.Text & "*.xls" Then
                Listtasinir.AddItem dosya.Name
            End If
        End If
    Next
    Set lst = Nothing
   End Sub