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...
(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