Quantcast
Channel: Microsoft Access Forum
Viewing all articles
Browse latest Browse all 880

Per VBA erstellte Termine landen zum größten Teil im Papierkorb von Outlook 2010

$
0
0

Moin,

ich versuche aus Access 2010 automatisch Termine zu erstellen (über die Schnittstelle zum Outlook 2010). Allerdings landet der größte Teil davon direkt im Papierkorb, mit folgender Meldung:

"Diese Besprechungsanfrage wurde aktualisiert, nachdem diese Nachricht gesendet wurde. (...)"

Mein VBA-Code sieht wie folgt aus:

Option Compare Database
Option Explicit

Private Sub Form_AfterInsert()
 On Error GoTo err_proc
    Dim oOutlookApp As Outlook.Application
    Dim oOutlookTermin As Outlook.AppointmentItem
    ' Recordset-Objekt deklarieren
    Dim rs As DAO.Recordset
                
    Set oOutlookApp = CreateObject("Outlook.Application")
    Set oOutlookTermin = oOutlookApp.CreateItem(olAppointmentItem)
    ' Recordset-Objekt initialisieren
    Set rs = CurrentDb.OpenRecordset("Select Projektname, Wiedervorlage, Laufzeitende, [Bearbeiter Justiziariat], [Aktenzeichen Justiziariat], Institut From Vertrag WHERE Wiedervorlage is not NULL")
    Do While Not rs.EOF
      If CDate(rs!Wiedervorlage) > CDate(Date) Then
      With oOutlookTermin
        .MeetingStatus = olMeeting
        .Recipients.Add ("e@mail")
        .Start = CDate(rs!Wiedervorlage) + CDate(#10:00:00 AM#)
        .Duration = 30
        .Subject = rs!Projektname
        .Body = "Der Vertrag endet am " & rs!Laufzeitende & vbCrLf & "Bearbeiter: " & rs![Bearbeiter Justiziariat] & vbCrLf & _"Aktenzeichen Justiziariat: " & rs![Aktenzeichen Justiziariat] & vbCrLf & "Institut: " & rs!Institut
        .ReminderSet = True
        .ReminderMinutesBeforeStart = 5
        .Send
      End With
      End If
      rs.MoveNext
     Loop
end_proc:
    rs.Close
    Set oOutlookApp = Nothing
    Exit Sub
err_proc:
    'On Error Resume Next
    MsgBox Err.Description, , Err.Number
    Resume end_proc
End Sub

Nun würde ich gerne verstehen, warum das so ist und was ich machen kann, damit die im Posteingang landen.


Gruß

Jens



Viewing all articles
Browse latest Browse all 880


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>