Skip to main content

AccessTr.neT


Excelden Veri Alarak Tablo Oluşturmak

Excelden Veri Alarak Tablo Oluşturmak

#7
notlar tablosu başlangıçta boş mu olacak?
Cevapla
#8
(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.
Cevapla
#9
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
.rar ExceldenAccesseGuncelleSorgusu_hy.rar (Dosya Boyutu: 49,09 KB | İndirme Sayısı: 5)
Cevapla
#10
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.



[Resim: do.php?img=10460]



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
.rar Test.rar (Dosya Boyutu: 133,09 KB | İndirme Sayısı: 1)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da