24/08/2020, 22:49
Sayfalar: 1 2
24/08/2020, 22:53
(24/08/2020, 22:49)berduş yazdı: [ -> ]notlar tablosu başlangıçta boş mu olacakevet. 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.
24/08/2020, 23:51
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ı
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
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
25/08/2020, 00:41
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.
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
Sayfalar: 1 2