Private Sub BtnEgitEkle_1_Click()
Dim VrdRS As New ADODB.Recordset
Dim GunRS As New ADODB.Recordset
Dim x, xTarih As Long
Dim VrdSrg, VrdSrgB, GunSrg, KriterMod As String
Dim BasTrh, BitTrh, Modx As Long
Dim ModAdi As String
Dim ModSec() As String
ModSec = Split("4A;4B;4C;4D", ";")
BasTrh = CLng(DateSerial(2020, 2, 1))
BitTrh = CLng(DateSerial(2020, 3, 0))
Modx = CLng(DateSerial(2020, 1, 3))
VrdSrgB = " SELECT liste.Kimlik, liste.vardiya " & _
" FROM TblTmpVrdy INNER JOIN (liste LEFT JOIN TblEgtm ON liste.Kimlik = TblEgtm.Kisi) ON " & _
" TblTmpVrdy.Vardiya = liste.vardiya " & _
" WHERE (((TblEgtm.Kisi) Is Null) AND ((Month([tarih]))=2)"
CurrentDb.Execute "delete from TblTmpVrdy"
'hy_vardiya tablosuna GÜN ve Vardiya ekleme____________________________
For x = BasTrh To BitTrh
y = DateDiff("d", Modx, x) Mod (24)
If y > 17 Then ModAdi = "B"
If y > 11 And y < 18 Then ModAdi = "A"
If y < 12 Then ModAdi = "D"
If y < 6 Then ModAdi = "C"
If InStr(1, "67", Weekday(x, 0)) = 0 Then _
CurrentDb.Execute " insert into TblTmpVrdy (VardiyaTrh,Vardiya) values (" & x & ",'4" & ModAdi & "')"
Next x
'hy_vardiya tablosuna GÜN ve Vardiya ekleme____________________________BİTTİ
'hy_Eğitim tablosuna KİŞİ ekleme____________________________
ModBas = LBound(ModSec)
modBit = UBound(ModSec)
For x = ModBas To modBit
'hy_Moda_Göre_Günler_Sorgusu_______________________________________________
GunSrg = " SELECT TblTmpVrdy.VardiyaTrh, TblTmpVrdy.Vardiya " & _
" FROM TblTmpVrdy " & _
" WHERE (((TblTmpVrdy.Vardiya)='" & ModSec(x) & "'));"
GunRS.Open GunSrg, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'hy_Moda_Göre_Kişiler_Sorgusu_______________________________________________
KriterMod = " AND ((liste.vardiya)='" & ModSec(x) & "')) " & _
" GROUP BY liste.Kimlik, liste.vardiya "
VrdSrg = VrdSrgB & KriterMod
VrdRS.Open VrdSrg, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Do While VrdRS.RecordCount > 0
If GunRS.EOF Then GunRS.MoveFirst
VrdRS.MoveFirst
CurrentDb.Execute " insert into TblEgtm (Gun, Kisi) values (" & CLng(GunRS(0)) & "," & VrdRS(0) & ")"
VrdRS.Requery
GunRS.MoveNext
Loop
VrdRS.Close
GunRS.Close
Next x
'hy_Eğitim tablosuna KİŞİ ekleme____________________________BİTTİ
MsgBox "Eğitim Dağıtımı tamamlandı"
End Sub
Dilerim işinize yarar