200 Sütunlu Insert Sorgusu

[Prostar]

Benim şöyle bir sorum olacak.
Bir RecordSet'i Excele alabilmek için

Range("F3").CopyFromRecordset rs

gibi bir kod yazıyoruz. Bunun benzerini Acces ile yapmak mümkünmüdür.

Siteden aldığım bir kod örneği.

Sub Emre()
    Dim con As Object, rs As Object
    Dim sorgu As String, dosya As String
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordSet")
        Range("F3:G100").ClearContents
        dosya = ThisWorkbook.FullName
        con.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=" & _
        dosya & ";Extended Properties=""Excel 12.0;hdr=no"""
        sorgu = "Select distinct(F1), sum(F2) FROM [Sheet1$B3:C16] group by F1 "
        rs.Open sorgu, con, 1, 1
        Range("F3").CopyFromRecordset rs
        Range("F65536").End(3)(2, 1) = "GENEL TOPLAM"
        Range("G65536").End(3)(2, 1) = WorksheetFunction.Sum(Range("C3:C16"))
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
    dosya = vbNullString: sorgu = vbNullString
End Sub

Sorum ise şöyle;
200 sütunluk bir RecordSet'im var. Bu kayıtları başka bir Access nesnesine atmak istiyorum.

Bir SQL sorgusu bir SQL serverdaki tabloyu Select ile alıyor, sonra tablo sütunları bire bir aynı olan Access içerisindeki diğer bir tabloya insert edilecek. Bu durumda Insert Sorgusu için

Insert Into TabloAdı Values(1.Sütun, 2.Sütun,3.Sütun,....200.Sütun yazmak bayağı zor oluyor.

Bunun daha kısa bir yolu varmıdır.
Insert Into TabloAdı Values(RecordSet) gibi bir şey olabilir mi?

 

[Taruz]

....
.....................
Bunun daha kısa bir yolu varmıdır.
Insert Into TabloAdı Values(RecordSet) gibi bir şey olabilir mi?

Merhaba..

Eklenen ve eklenecek tabloda otomatik sayı veya birincil anahtar içeren bir alan yoksa ve her iki tablo aynı alanlara sahipse sorunu joker karakterle aşabilirsiniz..:

insert into eklenecek_rs select * from kaydinoldugu_rs

Diğer türlü işiniz zor olacak..

 

[Prostar]

Kodlarım şöyle;

Sub EtaVTSicilBirlestir()
 Dim Guncelle As String, Sorgu As String
 Simdi = Now
 
 'Önceki verileri sildik
 CurrentDb.Execute "Delete From EtaSicilSQLCalis"
 
 
 'EtaMaster VT Bağlantısı
 Call BaglanSQL("IKSERVER\ETA", "ETA_MASTER")
 'Eta Şirketlerinin Listesini Al
 Call RecExec("Select * From dbo.SIRKET")
 'Eta şirketlerinde dön
 Do Until Rec.EOF
 'On Error Resume Next 'Olmayan firmalar Eta_Master içinden silinmemiş.
  
  'Veritabanlarına Veritabanı Adı ve Şisrket Kodu Update
  Guncelle = "Update [" & Rec![SIRDBNAME] & "].[dbo].[BORSICIL] SET BORSCLMUHHESKOD = '" & Rec![SIRDBNAME] & "', BORSCLOKOD5 = '" & Rec![SIROZELKOD3] & "'"
  Call BaglanSQL("IKSERVER\ETA", "ETA_MASTER")
  Call RecExec(Guncelle)
  
 
  'TumEtaSicilBilgileri VT Bağlantısı
  Call BaglanSQL("IKSERVER\ETA", "TumEtaSicilBilgileri")
  'Eta Şirketlerinin Bordro ve Kimlik bilgileri alınıyor
  VeriTabani = Rec![SIRDBNAME]
  
  Sorgu = "SELECT [" & VeriTabani & "].[dbo].[BORSICIL].*, [" & VeriTabani & "].[dbo].[KIMLIKLER].* FROM [" & VeriTabani & "].[dbo].BORSICIL INNER JOIN [" & VeriTabani & "].[dbo].KIMLIKLER ON [" & VeriTabani & "].[dbo].BORSICIL.BORSCLKOD = [" & VeriTabani & "].[dbo].KIMLIKLER.KIMKOD;"
  
  Call RecExec1(Sorgu)
   Do Until Rec1.EOF
    Dim Stn As Object
    sayac = 0
    For Each Stn In Rec1.Fields
     Fields = Fields & Stn.Name & ","
     Values = Values & "'" & Rec1.Fields(sayac) & "',"
     sayac = sayac + 1
    Next Stn
    Fields = Left(Fields, Len(Fields) - 1)
    Values = Left(Values, Len(Values) - 1)
    [B][COLOR="Red"]CurrentDb.Execute "Insert Into EtaSicilSQLCalis (" & Fields & ") Values (" & Values & ")"[/COLOR][/B]    'CurrentDb.Execute "Insert Into EtaSicilSQLCalis " & Rec1
    Fields = Empty
    Values = Empty
    Rec1.MoveNext
  Loop
 Rec.MoveNext
 Loop
 Con.Close
 MsgBox Format(Now - Simdi, "hh:mm:ss") & Chr(10) & "Tamamlandı"
 End Sub

Function BaglanSQL(Server As String, Catalog As String)
 On Error GoTo hata:
 Set Con = New ADODB.Connection
 'If Con.State = ObjectStateEnum.adStateClosed Then Con.Open "Provider=SQLOLEDB;server='" & Server & "';User ID=sa;Password=eta;Initial Catalog='" & Catalog & "'"
 If Con.State = ObjectStateEnum.adStateClosed Then Con.Open "Provider=SQLOLEDB;server=IKSERVER\ETA;User ID=sa;Password=eta;Initial Catalog='" & Catalog & "'"
hata:   If Err Then Exit Function
End Function

Function RecExec(Sorgu As String)
 If Con.State = ObjectStateEnum.adStateOpen Then
  Set Rec = Con.Execute(Sorgu)
  Debug.Print Sorgu
 End If
End Function

Function RecExec1(Sorgu As String)
 If Con.State = ObjectStateEnum.adStateOpen Then
  Set Rec1 = Con.Execute(Sorgu)
  Debug.Print Sorgu
 End If
End Function

İşler bu kısımda karşıyor
CurrentDb.Execute "Insert Into EtaSicilSQLCalis (" & Fields & ") Values (" & Values & ")"

Sorunum çözüldü ama Nesne olarak eklemeyi başaramadım.