excelde meydana gelen değişilikleri bağlantılı access veritabanında update etme

[ziraatci26]

excelde meydana gelen değişilikleri bağlantılı access veritabanında update etme

Arkadaşlar ekte gönderdiğim dosyada accessden çektiğim verilerde excel ortamında yapacağım değişiklikleri accesde update etmek istiyorum.Çok acil yardımcı olursanız sevinirim.

 

[Mahmut Kök]

Arkadaşlar ekte gönderdiğim dosyada accessden çektiğim verilerde excel ortamında yapacağım değişiklikleri accesde update etmek istiyorum.Çok acil yardımcı olursanız sevinirim.

Excel belgeinizle vt1.mdb aynı klasörde olsun. Excel belgenize DAO referansı ekleyiniz.

Sub guncelle()
Dim dbs As DAO.Database, dst As DAO.Recordset
Dim veriyolu As String
veriyolu = ThisWorkbook.Path
Set dbs = OpenDatabase(veriyolu & "\vt1.mdb")

For a = 2 To [a65536].End(3).Row
Set dst = dbs.OpenRecordset("select * from sayfa1 where id=" & Cells(a, "a"))
dst.Edit
dst("isim") = Cells(a, "b")
dst("ürün") = Cells(a, "c")
dst("fiyat") = Cells(a, "d")
dst.Update
Next
dst.Close
dbs.Close
set dbs=nothing
set dst=nothing
End Sub

 

[Haluk]

Alternatif (ADO)

Sub Test()
    Dim adoCN As Object
    Dim DatabasePath As String
    Dim RS As Object
    
    Set adoCN = CreateObject("ADODB.Connection")
    DatabasePath = ThisWorkbook.Path & "\vt1.mdb"
    
    If Dir(DatabasePath) = "" Then
        MsgBox DatabasePath & " bulunamadı, programdan çıkılacak !", vbCritical, "TestDB"
        Exit Sub
    End If
    
    adoCN.Provider = "Microsoft.Jet.OLEDB.4.0"
    adoCN.ConnectionString = DatabasePath
    adoCN.Open
    
    NoA = Cells(65536, 1).End(xlUp).Row
    
    Set RS = CreateObject("ADODB.recordset")
    
    For i = 2 To NoA
        strSQL = "select * from [Sayfa1] where id=" & Cells(i, 1)
        RS.Open strSQL, adoCN, 1, 3
        
        If RS.RecordCount > 0 Then
            RS.Delete
            RS.Update
        End If
        
        RS.AddNew
        RS("id") = Cells(i, 1)
        RS("isim") = Cells(i, 2)
        RS("ürün") = Cells(i, 3)
        RS("fiyat") = Cells(i, 4)
        RS.Update
        RS.Close
    Next
    
    Set RS = Nothing
    Set adoCN = Nothing
End Sub

 

[Haluk]

Yukarıdaki alternatifimi biraz daha geliştirdim. Şimdi, Excel çalışma sayfasındaki veriler silindiğinde son haliyle veri tabanına aktarılmaktadır.

Diğer bir deyişle, önce veri tabanındaki Sayfa1 isimli tablonun içeriği siliniyor, daha sonra da Excel çalışma sayfasındaki veriler veri tabanında Sayfa1 isimli tabloya aktarılmaktadır. Böylece, Excel çalışma sayfasındaki veriler tam anlamıyla veri tabanında güncellenmektedir.

Kodları hazırladığım PC' de MS Access olmadığı için sözkonusu mdb dosyasını açıp bakma imkanım yok ancak kodlara ilave ettiğim veri tabanındaki kayıt sayısı mesajıyla, güncellemenin doğru olarak yapıldığını sanıyorum.

Sub Test2()
    'Haluk ®
    '12/11/2007
    Dim adoCN As Object
    Dim DatabasePath As String
    Dim RS As Object
    
    Set adoCN = CreateObject("ADODB.Connection")
    DatabasePath = ThisWorkbook.Path & "\vt1.mdb"
    
    If Dir(DatabasePath) = "" Then
        MsgBox DatabasePath & " bulunamadı, programdan çıkılacak !", vbCritical, "TestDB"
        Exit Sub
    End If
    
    adoCN.Provider = "Microsoft.Jet.OLEDB.4.0"
    adoCN.ConnectionString = DatabasePath
    adoCN.Open
    
    NoA = Cells(65536, 1).End(xlUp).Row
    
    Set RS = CreateObject("ADODB.recordset")
    
    strSQL = "select * from [Sayfa1]"
    RS.Open strSQL, adoCN, 1, 3
    strSQL = "delete * from [Sayfa1]"
    adoCN.Execute (strSQL)
    RS.Update
    RS.Close
    
    strSQL = "select * from [Sayfa1]"
    RS.Open strSQL, adoCN, 1, 3

    For i = 2 To NoA
        RS.AddNew
        RS("id") = Cells(i, 1)
        RS("isim") = Cells(i, 2)
        RS("ürün") = Cells(i, 3)
        RS("fiyat") = Cells(i, 4)
        RS.Update
    Next
    
    RS.Close
    
    strSQL = "select * from [Sayfa1]"
    RS.Open strSQL, adoCN, 1, 3
    MsgBox "Veri tabanındaki toplam kayıt sayısı = " & RS.RecordCount & " adet", vbInformation, "Rapor"
    RS.Close
    
    Set RS = Nothing
    Set adoCN = Nothing
End Sub

 

[ziraatci26]

sağol hocam ellerine sağlık