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