Access'den Excel'e Farklı Tablolardan Veri Aktarma Sorunu

1 2
23/09/2021, 11:01

karacaayt

Arkadaşlar Excel'den Access'in bir veri tabanına bağlanıp veri çekebiliyorum ama aynı kodu kopyalayım mevut kodun altına yapıştırarak (aşağıdaki kodla) aynı anda iki veri tabanından veri çekmeye çalışıtığımda hata veriyor. Sorun nerededir, yardımcı olursanız sevinirim. İlgili Access ve Excel dosyaları da ektedir.  

Kod:
Private Sub CommandButton1_Click()

Dim SQL As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection

SQL = "SELECT * FROM Sorgu1 WHERE Ad = 'Fatih'"


Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection

ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & ThisWorkbook.Path & "\Örnek.accdb;"
  
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1 ' güncelleme yapabilmek için 1,3 0lmalı yada  adOpenKeyset, adLockOptimistic

Sheets("Sayfa1").Range("A4") = ADO_RS.Fields("Ad")



son:
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing


Dim SQL As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection

SQL = "SELECT * FROM Sorgu2 WHERE Ad = 'Nur'"


Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection

ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & ThisWorkbook.Path & "\Örnek.accdb;"
  
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1 ' güncelleme yapabilmek için 1,3 0lmalı yada  adOpenKeyset, adLockOptimistic

Sheets("Sayfa1").Range("A5") = ADO_RS.Fields("Ad")



son:
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing


End Sub
23/09/2021, 11:06

berduş

Dim Sql As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection
bu tanımlar 2 defa yapıldığı için hata veriyor olabilir
bir prosedürde her tanımlayıcı 1 defa kullanılır o nedenle tekrar aynı adı veremezsiniz
2. yazdığınız yerdeki kodları bu 3 satırı silerek dener misiniz?

şimdi fark ettim son: da 2 defa kullanılmış galiba
23/09/2021, 11:13

berduş

buradaki amacınızı tam olarak anlayamadım
sadece denememi yapıyorsunuz?
23/09/2021, 15:23

karacaayt

Bu dosya tamamen örnek amaçlı, asıl proje şirkete ait bilgiler içerdiği için paylaşmam problem olabilir. Asıl amacım Excelde dashboard gibi bir bilgi sayfası oluşturmak. Bunun için de iki üç veri tabanından veri çekmem gerekiyor. O nedenle bu konuyu açtım. Cevabınız için çok teşekkür ederim, silince çalıştı.
23/09/2021, 16:17

berduş

Rica ederim
Iyi çalışmalar
23/09/2021, 17:02

karacaayt

Üstad kusura bakma tekrar yazıyorum ama şu kodda yine hata verdi sıkıntı ne olabilir?
Kod:
Private Sub Workbook_Open()

Dim SQL As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection

SQL = "SELECT il,hedef_tutar FROM Hedef_Gerceklesme_2021 "


Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection

ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & ThisWorkbook.Path & "DATA\data.accdb;"
   
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1 ' güncelleme yapabilmek için 1,3 0lmalı yada  adOpenKeyset, adLockOptimistic

Range("B3").CopyFromRecordset ADO_RS


Set ADO_RS = Nothing
Set ADO_CN = Nothing


SQL = "SELECT tutar FROM Hedef_Gerceklesme_2021 "


Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection

ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & ThisWorkbook.Path & "DATA\data.accdb;"
   
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1 ' güncelleme yapabilmek için 1,3 0lmalı yada  adOpenKeyset, adLockOptimistic

Range("B3").CopyFromRecordset ADO_RS


Set ADO_RS = Nothing
Set ADO_CN = Nothing


SQL = "SELECT Tutar_2020 FROM 2020_Genel_Toplam"


Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection

ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & ThisWorkbook.Path & "DATA\data.accdb;"
   
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1 ' güncelleme yapabilmek için 1,3 0lmalı yada  adOpenKeyset, adLockOptimistic

Range("H3").CopyFromRecordset ADO_RS



son:
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing


End Sub
1 2