+- AccessTr.neT (https://accesstr.net)
+-- Forum: AccessTr.neT Genel (https://accesstr.net/forum-accesstr-net-genel.html)
+--- Forum: Çöp Kutusu (https://accesstr.net/forum-cop-kutusu.html)
+--- Konu Başlığı: Excelden Accesse veri gönderme (/konu-excelden-accesse-veri-gonderme.html)
Excelden Accesse veri gönderme - ynlmz - 02/12/2013
Sayın Hocalarım;
Sub ADOFromExcelToAccess()
Dim conn As Object
Dim rs As Object
Dim asay As Integer
asay = WorksheetFunction.CountA(Sheets("Analiz").Range("c9:c48"))
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RecordSet")
With cn
.Provider = "Microsoft.JET.OLEDB.4.0"
.Open ThisWorkbook.Path & "\OgretmenSinav.mdb"
End With
rs.Open "Yedek", cn, adOpenKeyset, adLockOptimistic, adCmdTable
With rs
For i = 1 To asay
.AddNew
.Fields("Ders") = Sheets("Analiz").Cells(5, 4)
.Fields("Dönem") = Sheets("Analiz").Cells(4, 4)
.Fields("SınavNo") = Sheets("Analiz").Cells(3, 14)
.Fields("okulno") = Sheets("Analiz").Cells(8 + i, 3)
.Fields("adısoyadı") = Sheets("Analiz").Cells(8 + i, 4)
.Fields("1") = Sheets("Analiz").Cells(8 + i, 5)
.Fields("2") = Sheets("Analiz").Cells(8 + i, 6)
.Fields("3") = Sheets("Analiz").Cells(8 + i, 7)
.Fields("4") = Sheets("Analiz").Cells(8 + i, 8)
.Fields("5") = Sheets("Analiz").Cells(8 + i, 9)
.Fields("6") = Sheets("Analiz").Cells(8 + i, 10)
.Fields("7") = Sheets("Analiz").Cells(8 + i, 11)
.Fields("8") = Sheets("Analiz").Cells(8 + i, 12)
.Fields("9") = Sheets("Analiz").Cells(8 + i, 13)
.Fields("10") = Sheets("Analiz").Cells(8 + i, 14)
.Fields("11") = Sheets("Analiz").Cells(8 + i, 15)
.Fields("12") = Sheets("Analiz").Cells(8 + i, 16)
.Fields("13") = Sheets("Analiz").Cells(8 + i, 17)
.Fields("14") = Sheets("Analiz").Cells(8 + i, 18)
.Fields("15") = Sheets("Analiz").Cells(8 + i, 19)
.Fields("16") = Sheets("Analiz").Cells(8 + i, 20)
.Fields("17") = Sheets("Analiz").Cells(8 + i, 21)
.Fields("18") = Sheets("Analiz").Cells(8 + i, 22)
.Fields("19") = Sheets("Analiz").Cells(8 + i, 23)
.Fields("20") = Sheets("Analiz").Cells(8 + i, 24)
.Fields("Sınıf") = Sheets("Analiz").Cells(2, 14)
.Update
Next i
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub