ExecuteExcel4Macro Yöntemi ile Combobox'a veri alma

[DeliBalta58]

Değerli uzmanım anemos'un tavsiyeleri ile
ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[kurum.xls]Sayfa1'!R41C2")
yöntemi ile kapalı dosyadan veri alma yöntemini kullanmaya başladım.

Bu yöntemle Combobox ve Listbox'a veri alabilirmiyiz.

Eskiden sayfayı açıp bilgileri alıp kapatıyor idim.
Eski kodlarım

Private Sub UserForm_Activate()
Dim say As Integer
Dim i As Integer
Workbooks.Open ThisWorkbook.Path & "\kurum.xls"
Workbooks.Open ThisWorkbook.Path & "\ekonomik_kod.xls"
Workbooks.Open ThisWorkbook.Path & "\eczaneler.xls"
Set krm= Workbooks("kurum.xls").Worksheets("sayfa1")
Set ekkod= Workbooks("ekonomik_kod.xls").Worksheets("sayfa1")

say = WorksheetFunction.CountA(Sheets("Sayfa1").Range("B2:B65500"))
ListBox1.RowSource = "sayfa1!B2:H65500"
txtsira_eczane = say
ListBox1.ColumnCount = 7
ListBox1.ColumnWidths = 150 & ";" & 70 & ";" & 50 & ";" & 70 & ";" & 50 & ";" & 90 & ";" & 50
ListBox1.ColumnHeads = True
Label12.Caption = krm.[C2]
Label13.Caption = krm.[C3]
Label14.Caption = krm.[C4]
Label15.Caption = krm.[C5]
Label16.Caption = krm.[C6]

Label17.Caption = krm.[C7]
Label18.Caption = krm.[C8]
Label19.Caption = krm.[C9]
Label20.Caption = krm.[C10]

Label21.Caption = ekkod.[A26]
Label22.Caption = ekkod.[B26]
Label23.Caption = ekkod.[C26]
Label24.Caption = ekkod.[D26]
Label31.Caption = ekkod.[E26]
TextBox40.Text = krm.[B18]
End Sub

bu kodları nasıl değiştirebilirim acaba

 

[Zeki Gürsoy]

Listbox1.Rowsource = "Sayfa1!b2:h65536" olarak belirttiğiniz kaynak hangi dosyaya ait olacak?

 

[DeliBalta58]

Workbooks.Open ThisWorkbook.Path & "\eczaneler.xls"
eczaneler kitabındaki veriler alınmakta

 

[Zeki Gürsoy]

İki alternatif metot veriyorum. Hangisi kolayınıza gelirse onu kullanın.

Sub Veri_Al1()
Dim Cn As Object, Rs As Object, i As Byte
 
Set Cn = CreateObject("ADODB.Connection")
 
    Cn.Open _
    "Driver={Microsoft Excel Driver (*.xls)};dbq=" & _
        ThisWorkbook.Path & "\eczaneler.xls"
 
    Set Rs = Cn.Execute( _
        "select * from [sayfa1$]")
 
    While Not Rs.EOF
 
        With ListBox1
            .AddItem
 
            For i = 1 To 8
                .List(ListBox1.ListCount - 1, i - 1) = Rs(i - 1)
            Next
 
        End With
 
        Rs.movenext
    Wend
 
Rs.Close
Cn.Close
 
Set Rs = Nothing
Set Cn = Nothing
 
End Sub

Sub Veri_Al2()
Dim deg As Variant, i As Long, j As Byte
 
    i = 1
    Do
        i = i + 1
        deg = ExecuteExcel4Macro("'" & _
            ThisWorkbook.Path & "\[eczaneler.xls]Sayfa1'!R" & _
                i & "C1")
 
        If deg = Empty Then Exit Do
 
        ListBox1.AddItem
        For j = 1 To 8
           ListBox1.List(ListBox1.ListCount - 1, j - 1) = _
            ExecuteExcel4Macro("'" & _
                ThisWorkbook.Path & "\[eczaneler.xls]Sayfa1'!R" & _
                    i & "C" & j)
        Next
 
    Loop
 
End Sub

 

[DeliBalta58]

Elinize sağlık.