Access de tablolar arası Satır taşımak

[Bilgemen]

Merhaba Arkadaşlar.
Microsoft accsessde te
AçıkFisler Tablosunda Me.LblSozlesmeNo.Caption da bulunan id nolu kayıtı KapalıFisler Tablosuna nasıl taşıyabilirm.
Aşağıdaki kodu bir türlü çalıştıramadım.
Şimdiden teşekkürler.

Sub tasi()
Dim id As Long
Dim xEkle As String
Set baglan = CreateObject("adodb.connection")
Call baglanti
    id = Me.LblSozlesmeNo.Caption ' OpenFisler tablosundaki id
  
    ' KapalıFisler tablosuna ekleme yapmak için INSERT INTO SQL sorgusu oluşturun

    xExle = "INSERT INTO KapalıFisler (Kimlik, HareketTipi, Guntipi, UrunBarkodu, UrunCinsi, UrunAdi, UrunRengi, Aksesuar, KuaforHizmeti, GelinAdi, GelinTelefon, DamatAdi, DamatTelefon, Tarih, Ay, Yil, Borc, Odeme, Kalan, Açıklama, FisTarihi, GeriadeTarihi) " & _
          "SELECT Kimlik, HareketTipi, Guntipi, UrunBarkodu, UrunCinsi, UrunAdi, UrunRengi, Aksesuar, KuaforHizmeti, GelinAdi, GelinTelefon, DamatAdi, DamatTelefon, Tarih, Ay, Yil, Borc, Odeme, Kalan, Açıklama, FisTarihi, GeriadeTarihi FROM AcikFisler " & _
          "WHERE Kimlik=" & id
  
  baglan.Execute xEkle
 
    baglan.Close
    Set baglan = Nothing
  
    MsgBox "Kayıt başarıyla taşındı!"
End Sub

 

[veyselemre]

VBA da INSERT INTO bende daha önce çalışmasına rağmen 4-5 sene önce yaptığım bir güncelleme sonrasında çalışmamaya başladı. Bende aşağıdaki gibi kayıt ekliyorum.

Sub tablodanTabloyaRecordsetKopyala()
    Dim id As Long, rsOld As Object, strSql$, i%
    Call baglanti
    id = Me.LblSozlesmeNo.Caption    ' OpenFisler tablosundaki id

    Set rsOld = CreateObject("ADODB.Recordset")
    strSql = "SELECT * FROM AcikFisler WHERE Kimlik=" & id
    rsOld.Open strSql, baglan

    With CreateObject("ADODB.Recordset")
        .Open "KapalıFisler", baglan, 1, 3, 2
        .AddNew
        For i = 1 To rsOld.Fields.Count - 1    'Normalde 0 dan başlayacak ancak aynı ID varsa hata verir.
            .Fields(rsOld.Fields(i).Name) = rsOld.Fields(i).Value
        Next i
        .Update
        .Close
    End With

    rsOld.Close
    baglan.Close
    Set baglan = Nothing

    MsgBox "Kayıt başarıyla taşındı!"
End Sub

 

[Haluk]

Bende aşağıdaki kod çalışıyor........ bu arada; ilk mesajdaki kodda SQL değişkenindeki "Açıklama" alanı "Aciklama" olarak değiştirilmeli.

Private Sub baslat_Click()
    Set adoCN = CreateObject("ADODB.Connection")
        
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\Datalar.accdb"
    
    adoCN.Open strConnection
    
    id = Me.LblSozlesmeNo.Caption
    
    strSQL = "INSERT INTO [KapalıFisler] (Kimlik, HareketTipi, Guntipi, UrunBarkodu, UrunCinsi, UrunAdi, UrunRengi, Aksesuar, KuaforHizmeti, GelinAdi, GelinTelefon, DamatAdi, DamatTelefon, Tarih, Ay, Yil, Borc, Odeme, Kalan, Aciklama, FisTarihi, GeriadeTarihi) " & _
             "SELECT Kimlik, HareketTipi, Guntipi, UrunBarkodu, UrunCinsi, UrunAdi, UrunRengi, Aksesuar, KuaforHizmeti, GelinAdi, GelinTelefon, DamatAdi, DamatTelefon, Tarih, Ay, Yil, Borc, Odeme, Kalan, Aciklama, FisTarihi, GeriadeTarihi FROM [AcikFisler] " & _
             "WHERE Kimlik=" & id
            
    adoCN.Execute strSQL
    
    MsgBox "Kayıt başarıyla taşındı!"
End Sub

.

 

[veyselemre]

İlk kodu defalarca denedim. Hata verdi. Bende suçu INSERT INTO ya attım.
Fakat asıl suçlu;
xExle = "INSERT .....

baglan.Execute xEkle

Kodun başında Option Explicit olsa bu hata hemen göze çarpardı.

Aşağıdaki gibi kısaca ekleyebilirsiniz. Aynı ID varsa hata verecektir. Hata kontrolü eklemeniz gerekir.

    xEkle = "INSERT INTO KapalıFisler SELECT * FROM AcikFisler WHERE Kimlik=" & id

 

[Bilgemen]

Merhaba.
Sace veysel Emre kardeşimizin ilk yazdığı kodlar çalıştı. Diğer arkadalaşların yazdığı kodlar malesef çalışmadı. Yinedende teşekkür ederim. herkese