Merhaba ;

Ms Access tablosunda yer alan bazı bilgileri başlangıç , bitiş tarihleri ve başlık içerik  biligileri Ms Outlook takvim beni uyaracak şekilde. Ms Acces ten Ms Outlook içine gönderecek bir çalışmaya başladım. 
Konuyla ilgili daha önce böyle bir çalışma yapmış veya bununla ilgili destek verecek...

Fikirlerinizi ve yardımlarınızı beklerim...

Merhaba, Microsoft Outlook Randevu Ekleme Uygulaması bağlantısındaki uygulamayı inceleyiniz. Sanırım aynı görevi yapıyor.

(17/07/2020, 12:14)ozanakkaya yazdı: Merhaba, Microsoft Outlook Randevu Ekleme Uygulaması bağlantısındaki uygulamayı inceleyiniz. Sanırım aynı görevi yapıyor.

Merhaba;
Tavsiye edilen uygulama güzel, ilk çalışma için baz alınabilir.
Üzerinde bazı değişiklikler yaptım ama istenilen şekilde çalışmadı. Dediğim gibi bu uygulama baz alınıp üzerinde biraz çalışılabilir.
Daha önce bu site yardımıyla çok güzel çalışmalarımız oldu ve aynı uygulamalarla eğer yanlış hatırlamıyorsam 2 yıl hala çalışıyorum. Elimde var olan uygulamayı biraz daha modifiye etmeye düşünüyorum.
Şimdi ...
Uygulamanın tablosuna başka tablodan data aktaracağım, ama aynı zamanda tek tek randevu oluşturabilsin. Aktarmış olduğum dataları toplu halde gönderebilmeli tek tek benim çok zamanımı alır.Düşünsenize 100 adet randevu tek tek. Daha iyi var olan verileri uygulamanın içine aktarıp sonra bu uygulamanın formunu açıp gönderilmemiş olanları bir anda göndermek. ve buna birde e-mail adresi eklenebilir mi, 3-4 e-mail eklene bilse güzel olur. Ofiste diğer takip edenlere göndermem için. Çok güzel olur.
Çalışmanın üzerinde biraz oynama yaptım tabi ki bunu yapınca hata verdi.
ekledim çalışmayı.

Hatanın sebebi, aynı kodun birden fazla kullanılmasından kaynaklanıyor. Bir denetim için herhangi bir olay yordamını sadece 1 defa yazabilirsiniz.
Private Sub Son_Kayıt_Click() olayı iki defa yazılmış. Aynı şekilde birden fazla yazılan olay yordamları mevcut.

Daha önce bağlantısını eklediğim örnek uygulamadır. İstediğiniz değişiklikleri yapabilirsiniz.

    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

 

Set outobj = Nothing



rsg.MoveNext

Loop

Üstteki kod, randevu tablosundaki randevueklendi onay kutusu işaretsiz olan tüm kayıtları kaydeder.

Merhaba;

tavsiyede bulunduğunuz düzeltmeyi yaptım çalıştı.
gelelim "Visual Basic Code " bunu tam anlayamadım
tam olarak ne yapmam gerekiyor onunla. bana sadece ikinci bir düğüme lazım ms outlok içine toplu gönderi yapsın ve gönderenleri işaretlesin....

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