Excelden Veri Alarak Tablo Oluşturmak

notlar tablosu başlangıçta boş mu olacak?

(24/08/2020, 22:49)berduş yazdı: notlar tablosu başlangıçta boş mu olacak

evet. ilk notlar girilmediği için boş olacak. Bu tablodaki öğrenci numarası kayıt bilgileri formuna bağlı. Butonla açıyorum ve o öğrenciye ait notlar geliyor. İlk girişte tablo boş olacak.

aşağıdaki kodla aynı klasörde bulunan Not1 ve Not2 Excel dosyalarındaki sayfa1de yer alan notları Access notlar  tablosuna aktarır.
dilerim işinize yarar
Not: Access ve Excel dosyaları aynı klasörde olmalı ve isimler kodlarda yazılan gibi olmalı dosyaların adı adresi yada diğer ad ve adreste yapılacak değişiklikler kodlara da aktarılmalı

'hy Excel dosyalarını bağlama_____________________________

Dim txtDosyaAdres As String

Dim txtExcelSyf As String

Dim txtTblAd As String



txtExcelSyf = "sayfa1!"



txtTblAd = "not1"

If DCount("Name", "MSysObjects", "Name='" & txtTblAd & "' and type in (1,4,6)") > 0 Then DoCmd.DeleteObject acTable, txtTblAd

txtDosyaAdres = CurrentProject.Path & "\not1.xlsx"

DoCmd.TransferSpreadsheet acLink, 10, txtTblAd, txtDosyaAdres, True, txtExcelSyf '& HcrAralik '"sayfa1!"



txtTblAd = "not2"

If DCount("Name", "MSysObjects", "Name='" & txtTblAd & "' and type in (1,4,6)") > 0 Then DoCmd.DeleteObject acTable, txtTblAd

txtDosyaAdres = CurrentProject.Path & "\not2.xlsx"

DoCmd.TransferSpreadsheet acLink, 10, txtTblAd, txtDosyaAdres, True, txtExcelSyf '& HcrAralik '"sayfa1!

'Excel Bğlama bitti____________________________________



'hy Not tablosuna öğrenci ekleme_______________________

Dim SqlOgr As String

SqlOgr = "INSERT INTO notlar ( Ögrencino ) " & _

        "SELECT [Öğrenci Bilgileri].[Öğrenci No] " & _

        "FROM [Öğrenci Bilgileri] LEFT JOIN notlar ON [Öğrenci Bilgileri].[Öğrenci No] = notlar.Ögrencino " & _

        "WHERE (((notlar.Ögrencino) Is Null))"

CurrentDb.Execute SqlOgr

'Öğrenci Ekleme bitti_____________________________________

'hy Notları notlar tablosuna ekleme

Dim SqlNot As String

SqlNot = "UPDATE (Not1 RIGHT JOIN notlar ON Not1.Ögrencino = notlar.Ögrencino)  " & _

        "LEFT JOIN Not2 ON notlar.Ögrencino = Not2.Ögrencino " & _

        "SET notlar.Not1 = [Not1]![Not1], notlar.Not2 = [Not2]![Not2]"

        Debug.Print

CurrentDb.Execute SqlNot

'Notları ekleme bitti

'hy gereksiz tabloları silme____________________________

txtTblAd = "not1"

If DCount("Name", "MSysObjects", "Name='" & txtTblAd & "' and type in (1,4,6)") > 0 Then DoCmd.DeleteObject acTable, txtTblAd

txtTblAd = "not2"

If DCount("Name", "MSysObjects", "Name='" & txtTblAd & "' and type in (1,4,6)") > 0 Then DoCmd.DeleteObject acTable, txtTblAd

If Err.Number = 0 Then MsgBox "hatasız bitti"

---

bilgilendirme: başlangıçta her adım için bir buton koymuştum ama sonra hepsini tek buton altında topladım
Hepsi butonu diğer 3 butonun yaptığını tek başına yapıyor

Bende doğru anladıysam alttaki kodlar işinizi görür.Benim yaptığım olay şöyle;accessteki notlar tablosunda öğrenci nolar varsa bu bu maraları excelden ilgili yerlere getirir.



not3 olacaksa koda ilave yapılacak.

Option Compare Database



Private Sub btnNotlargetir_Click()

  Call NotlarGetir("Not1", 1, "not1.xlsx") 'not1 excelden not getirme(1 demek Excel B sütunu icin),Not1=notlar tablosu Not1 alan adi accesin

  Call NotlarGetir("not2", 2, "not2.xlsx") 'not2 excelden not getirme(2 demek Excel C sütunu icin)

End Sub

Sub NotlarGetir(alanAd, alan2 As Byte, kitapAd As String)

    Dim con As ADODB.Connection

    Dim rs As ADODB.Recordset

    Dim sSql As String

    Dim yol As String

    Dim rs1 As ADODB.Recordset

    Dim conn As ADODB.Connection



    Set conn = CurrentProject.Connection

    Set rs1 = New ADODB.Recordset

    

    Set rs = New ADODB.Recordset

    Set con = New ADODB.Connection

    

    sSql = "select * from [Sayfa1$A2:C] where not isnull(f1)"

    

    yol = CurrentProject.Path & "\" & kitapAd

  

    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & yol & ";extended properties=""excel 12.0;hdr=No;imex=1"""

  

    rs.CursorLocation = adUseClient

    rs.CursorType = adOpenKeyset

    rs.LockType = adLockOptimistic

    

    rs1.Open "[notlar]", conn, adOpenDynamic, adLockOptimistic, adCmdTable

    

    rs.Open sSql, con

    

    Do Until rs.EOF

        'not1 icin

        If alan2 = 1 Then CurrentDb.Execute "UPDATE [notlar] SET [" & alanAd & "] = " & rs(1) & " WHERE [Ögrencino] = " & rs(0) & ""

        'not2 icin

        If alan2 = 2 Then CurrentDb.Execute "UPDATE [notlar] SET [" & alanAd & "] = " & rs(2) & " WHERE [Ögrencino] = " & rs(0) & ""

        rs.MoveNext

        DoEvents

    Loop

    DoCmd.OpenTable "notlar"

    CurrentDb.TableDefs.Refresh

    rs.Close

    con.Close

    Set rs = Nothing

    Set con = Nothing

    rs1.Close

    conn.Close

    Set rs1 = Nothing

    Set conn = Nothing



End Sub