Visual Basic Code kısmını yazmayacaksınız. altındaki kodları kullanacaksınız. Onay kutusunu işaretleyen hali aşağıdadır, koddaki hata blokları iptal edildi.

'On Error GoTo Err_RandevuEkle_Click



DoCmd.RunCommand acCmdSaveRecord



If Me!ony_randevueklendi = True Then

    MsgBox "Bu randevu daha önce eklenmiş"

    Exit Sub

Else

    Dim outobj As Outlook.Application

    Dim outappt As Outlook.AppointmentItem

    



    

    Sql = "SELECT *, randevueklendi From tbl_randevu WHERE (((randevueklendi)=False));"

Set rsg = CurrentDb.OpenRecordset(SQL)





rsg.MoveFirst



Do Until rsg.EOF = True



    Set outobj = CreateObject("outlook.application")

    Set outappt = outobj.CreateItem(olAppointmentItem)



            

            With outappt

                .Start = CDate(rsg!randevutarihi) & " " & CDate(rsg!randevusaati)

                .Duration = rsg!sure * rsg!sureperiyodu

                .Subject = rsg!konu

                .Body = rsg!randevumetni

                .Location = rsg!konum



                If Len(rsg!hatirlatici) > 0 Then

                    .ReminderMinutesBeforeStart = rsg!hatirlatici * rsg!hatirlaticiperiyodu

                    .ReminderSet = True

                Else

                    .ReminderMinutesBeforeStart = 0

                    .ReminderSet = False

                End If

                    .Save

        End With



'DoCmd.SetWarnings False



rsg.Edit

rsg!randevueklendi = True

rsg.Update



'DoCmd.SetWarnings True



Set outobj = Nothing



rsg.MoveNext

Loop

            

            

            

End If



'Me!ony_randevueklendi = True

Call OnayKontrol

DoCmd.RunCommand acCmdSaveRecord

'If MsgBox("Randevu Eklendi, randevu bilgileri açılsın mı", vbInformation + vbYesNo, "Randevu Eklendi...") = vbYes Then

'outappt.Display

'Else

'outobj.Quit

'End If

Set outobj = Nothing

'Exit_RandevuEkle_Click:

'Exit Sub

'Err_RandevuEkle_Click:

'MsgBox "Error " & Err.Number & vbCrLf & Err.Description

'Resume Exit_RandevuEkle_Click