Soru Kapalı Dosyadan ListBox'a Veri Çekmek KOD'daki Hatam Nedir.?

[oztuncla.27]

Merhaba Arkadaşlar;

Müşteri Takip Programında Raporlama Yapıyorum. Program Yeni müşteri Kaydında Proje içinde müşteri adında klasör oluşturuyor ve içine müşteri adında bir .XLSM Oluşturuyor. Ben Müşteri listesini raporlama bölümünde listbox'a aktarıyorum burada tıkladığım müşteriyi raporla dediğim zaman müşteri klasörü içerisinde bulunan excelin içindeki verileri listbox2 ye sıralasın istiyorum. Kodları internette ve sitemizden buldum fakat kendi projeme göre uyguladığım zaman hata alıyorum yardımcı olmursunuz.

KODLAR :

Private Sub BT5_Raporla_Click()
If LB5_FirmaListesi.Value = "" Then
MsgBox "Müşteri Şeçiniz!", vbInformation, "Müşteri Uyarısı"
Exit Sub
End If
Dim con As Object, rs As Object
    Dim sorgu As String, dosya As String
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordSet")
    LB5_Rapor.Clear
    dosya = LB5_FirmaListesi.Value
    con.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\TB5_Firmaadı\" & dosya & ";Extended Properties=""Excel 12.0;hdr=no"""
    LB5_Rapor.Clear
    sorgu = "Select * from [Muhasebe$A2:H] where not isnull(f1)"
    rs.Open sorgu, con, 1, 1
    With LB5_Rapor
        .ColumnCount = rs.Fields.Count
        .ColumnWidths = 50
        .Column = rs.GetRows
    End With
    Label54.Caption = "Dosya Adı: " & Replace(LB5_FirmaListesi.Value, ".xlsx", "")
    Label53.Caption = "Toplam Kayıt Sayısı: " & LB5_Rapor.ListCount
    rs.Close
    con.Close
    Set con = Nothing: Set rs = Nothing: dosya = vbNullString
End Sub

Private Sub UserForm_Initialize()

    Set ds = CreateObject("Scripting.FileSystemObject")
    Set f = ds.getfolder("C:\HESAP\" & TB2_firma & "")
    Set dc = f.Files
    For Each dosya In dc
    LB5_FirmaListesi.AddItem dosya.Name
    Next
    Label53.Caption = "Toplam Kayıt Sayısı: " & LB5_Rapor.ListCount
    
End Sub

Nerede hata Yapıyorum bulamadım.
Yardımlarınızı Bekliyorum.

Teşekkürler.

 

[oztuncla.27]

Yardım Edecek Kimse Yokmu ?

 

[Korhan Ayhan]

Ne hatası alıyorsunuz?

Örnek dosyalarınızı paylaşır mısınız?

 

[oztuncla.27]

Selamun Aleyküm.

Öncelikle ilginiz için çok teşekkür ederim.
Örnek dosya ekleyemiyorum pazartesi altın üyeliğe geçeceğim.
Hata Aldığım "
" sorgu = Select * FROM [Muhasebe$] where not isnull(ad) and ad='" & LB5_FirmaListesi.Value & "'"
rs.Open sorgu, con, 1, 3 "

RESİM :

Private Sub BT5_Raporla_Click()
If LB5_FirmaListesi.Value = "" Then
MsgBox "Müşteri Şeçiniz!", vbInformation, "Müşteri Uyarısı"
Exit Sub
End If
Dim con As Object, rs As Object
    Dim sorgu As String, dosya As String
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordSet")
    LB5_Rapor.Clear
    dosya = LB5_FirmaListesi.Value
    con.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\" & TB5_Firmaadı & dosya & ";Extended Properties=""Excel 12.0;hdr=no"""
    LB5_Rapor.Clear
    sorgu = "Select * FROM [Muhasebe$] where not isnull(ad) and ad='" & LB5_FirmaListesi.Value & "'"
rs.Open sorgu, con, 1, 3
    With LB5_Rapor
        .ColumnCount = rs.Fields.Count
        .ColumnWidths = 50
        .Column = rs.GetRows
    End With
    Label54.Caption = "Dosya Adı: " & Replace(LB5_FirmaListesi.Value, ".xlsx", "")
    Label53.Caption = "Toplam Kayıt Sayısı: " & LB5_Rapor.ListCount
    rs.Close
    con.Close
    Set con = Nothing: Set rs = Nothing: dosya = vbNullString
    End Sub

 

[Korhan Ayhan]

Paylaşım sitelerine dosyanızı yükleyip link verebilirsiniz.

Excel versiyonunuza göre bağlantı kodlarını revize etmeniz gerekebilir. Bu sebeple excel sürüm bilgisini profilinizde güncellemenizde fayda var.

 

[oztuncla.27]

Upload Sitesine yükleyip link vermek aklıma hiç gelmedi.
Şuan Office 2016 kullanıyorum.

DOSYA LİNKİ : https://trtransfer.net/download/250942ce3a4fd0ddd18542d9c8f9e2f1

Yardımlarınızı Bekliyorum.
İyi Çalışmalar.

 

[Korhan Ayhan]

Bende;

"TB2_firma" bu veriyi bulamadığı için hata veriyor. Sanırım dosyanızda eksik birşeyler var.

 

[oztuncla.27]

"TB5_firmaadı" Mı Demek İstediniz Çünkü Raporla Butonuna yazdığım kodlarda "TB2_firma" yoktur. "TB_firma" İşlem girme sayfasında. Ben "LB5_FirmaListesi"ne tıkladığım müşterinin veya "TB5_firmadı" da yazılı müşterinin bilgilerini "LB5_Rapor" Bölümüne Getirsin İstiyorum Müşteri Bilgileride Hesap Klasörünün içindeki her müşterinin adına ait klösör ve içlerinde ki excel dosyalarında. Benim sıkıntım klasör yolunda veya sorguda hatam var.

 

[Korhan Ayhan]

Userformu açmak istediğimde bu satırda bende hata veriyor.

Set f = ds.getfolder("C:\HESAP\" & TB2_firma & "")

İlgili klasörün altında ne olması gerekiyor.

 

[oztuncla.27]

Özür dilerim orayı kaçırmışım.
Orası " TB5_Firmaadı " Olacak, oda HESAP Klasörünün içindeki " TB5_Firmaadı " 'da yazan müşteri adının klasörüne gidecek.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki şekilde sonuç alabildim.

    con.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\" & TB5_Firmaadı & "\" & dosya & ".xlsm" & ";Extended Properties=""Excel 12.0;hdr=no"""
    LB5_Rapor.Clear
    sorgu = "Select * FROM [Muhasebe$] where not isnull(F3) and F3='" & LB5_FirmaListesi.Value & "'"

 

[oztuncla.27]

Merhabalar;

Üstadım "Nesne Kapalı Olduğunda İşleme İzin Verilmez" Diye Bir Hata Alıyorum Ben.

 

[oztuncla.27]

Çok Teşekkür Ederim Sorunu Hallettim Allah Razı Olsun.