Запланированная повторяющаяся электронная почта - PullRequest
0 голосов
/ 07 апреля 2020

Приведенный ниже код не дает ошибок компиляции, но не отправляет электронные письма.

Цель состоит в том, чтобы отправлять повторяющиеся электронные письма, связывая их с встречами.

Private Sub Application_Reminder(ByVal Item As Object)
Dim xMailItem As MailItem
Dim xItemDoc As Word.Document
Dim xNewDoc As Word.Document
On Error Resume Next
If Item.Class <> OlObjectClass.olAppointment Then Exit Sub
If Item.Categories <> "Send Schedule Recurring Email" Then Exit Sub
Set xMailItem = Outlook.Application.CreateItem(olMailItem)
Set xItemDoc = Item.GetInspector.WordEditor
xItemDoc.Activate
xItemDoc.Application.Selection.WholeStory
xItemDoc.Application.Selection.Copy
With xMailItem
    .To = Item.Location
    .Subject = Item.Subject
    Set xNewDoc = .GetInspector.WordEditor
    xNewDoc.Activate
    xNewDoc.Application.Selection.HomeKey
    xNewDoc.Content.Paste
    .Send
End With
Set xMailItem = Nothing
End Sub

Кажется, проблема в Item.Class. Я получаю сообщение о том, что

Недопустимая внешняя процедура.

1 Ответ

0 голосов
/ 07 апреля 2020

В конце концов, я немного флиртовал и нашел несколько полезных советов, в конце концов решил их следующим образом:

Dim WithEvents objReminders As Outlook.Reminders
Private Sub Application_Reminder(ByVal Item As Object)
Dim MItem As MailItem
Set MItem = Application.CreateItem(olMailItem)
If Item.MessageClass <> "IPM.Appointment" Then Exit Sub
If Item.Categories <> "Send Schedule Recurring Email" Then Exit Sub
MItem.To = Item.Location
MItem.CC = ""
MItem.BCC = ""
MItem.Subject = Item.Subject
MItem.BodyFormat = olFormatHTML
Item.GetInspector().WordEditor.Range.Copy
MItem.GetInspector().WordEditor.Range.Paste
MItem.Display
MItem.Send
Set MItem = Nothing
End Sub

Private Sub Application_Startup()
Set objReminders = Application.Reminders
End Sub
Private Sub objReminders_ReminderFire(ByVal ReminderOBject As Reminder)

If ReminderOBject.Item.Categories <> "Send Schedule Recurring Email" Then Exit Sub

ReminderOBject.Dismiss

End Sub

Надеюсь, это поможет

...