Termine per VBA anlegen

Wenn Du Termine nicht über die Benutzeroberfläche des Kalenders, sondern per VBA anlegen willst, haben wir Dir die Funktion CreateNewMeeting_Parameter vorbereitet.

Diese platzierst Du in einem Standardmodul:

Public Function CreateNewMeeting_Parameter(strSubject As String, strBody As String, strLocation As String, datStart As Date, datEnd As Date, Optional bolShow As Boolean = True)
Dim rs                  As DAO.Recordset
Dim lID                 As Long
Dim sSql                As String
Dim lHour               As Long
Dim lMinute             As Long
  Set rs = CurrentDb.OpenRecordset("SELECT * FROM TBL_CAL_MEETING WHERE TID=-1")
  With rs
    .AddNew
    lID = rs!TID                                              ' Zur weiteren Verwendung
    .Fields("TMASTER") = True                                 ' IST FÜR TIDSUB (ZEIGT AN WELCHER TERMIN DER ERSTE IST / BEGINN DATUM < ENDE DATUM)
    '**************   Siehe TBL_CAL_ACCOUNT   ***************************************************************************************************
    .Fields("TMID") = 1                                       ' MASTER ID FUER MEHRERE KONTEN
    '*********************************************************************************************************************************************
    .Fields("TDATE") = Int(datStart)                           ' START DATUM DES TERMINS
    .Fields("TDATEEND") = Int(datEnd)                        ' ENDE DATUM DES TERMINS
    lHour = Format(datStart, "HH")
    lMinute = Format(datStart, "nn")
    If lMinute < 15 Then
      lMinute = 0
    ElseIf lMinute > 14 And lMinute < 30 Then
      lMinute = 15
    ElseIf lMinute > 29 And lMinute < 45 Then
      lMinute = 30
    ElseIf lMinute > 44 And lMinute < 59 Then
      lMinute = 45
    Else
      lMinute = 0
      lHour = lHour + 1
    End If
    If lHour = 24 Then
      lHour = 0
    End If
    .Fields("TTIMEON") = Format(lHour & ":" & lMinute, "HH:MM")       ' UHRZEIT VON
    .Fields("TTIMEOFF") = DateAdd("n", 30, .Fields("TTIMEON"))        ' UHRZEIT BIS
    .Fields("TDAY") = False                                           ' GANZTÄGIGES EREIGNIS
    .Fields("TCAPTION") = strSubject ' BETREFF
    .Fields("TLOCATION") = strLocation ' ORT
    .Fields("TNOTICE") = strBody ' TEXT
    '**************   Siehe TBL_CAL_REMINDER   ***************************************************************************************************
    .Fields("TREMINDER") = True                                       ' ERINNERUNG AKTIV  JA / NEIN
    .Fields("TREMINDERDURATION") = -15                                ' MINUTEN VOR TERMIN TDATE
    .Fields("TREMINDERTEXT") = "15 Minuten"                           ' MINUTE, STUNDE, TAG, MONAT USW.
    .Fields("TREMINDERDAYTIME") = "12.09.2023 13:30:00"               ' ERINNERUNGS-DATUM UND ERNEUT ERINNERN DATUM UHRZEIT
    '*********************************************************************************************************************************************
    '**************   Siehe TBL_CAL_CATEGORY   ***************************************************************************************************
    .Fields("TCATEGORYCOLOR") = 10864631
    .Fields("TCATEGORYID") = 1
    '*********************************************************************************************************************************************
    '**************   Siehe TBL_CAL_POINTER   ****************************************************************************************************
    .Fields("TPOINTERCOLOR") = 3245299
    .Fields("TPOINTERID") = 4
    '*********************************************************************************************************************************************
    .Update
  End With
  If Not rs Is Nothing Then
    rs.Close: Set rs = Nothing
  End If
  If C_RCST_DAO_CATEGORY Is Nothing Then
    Set C_RCST_DAO_CATEGORY = CurrentDb.OpenRecordset("TRANSFORM First(TBL_CAL_CATEGORY.TCATEGORY) AS C SELECT TBL_CAL_CATEGORY.TFID FROM TBL_CAL_CATEGORY GROUP BY TBL_CAL_CATEGORY.TFID PIVOT TBL_CAL_CATEGORY.TPOS")
    Set C_RCST_DAO_CATEGORY_COLOR = CurrentDb.OpenRecordset("TRANSFORM First(TBL_CAL_CATEGORY.TCOLOR) AS C SELECT TBL_CAL_CATEGORY.TFID FROM TBL_CAL_CATEGORY GROUP BY TBL_CAL_CATEGORY.TFID PIVOT TBL_CAL_CATEGORY.TPOS")
    Set C_RCST_DAO_POINTER = CurrentDb.OpenRecordset("TRANSFORM First(TBL_CAL_POINTER.TPOINTER) AS C SELECT TBL_CAL_POINTER.TFID FROM TBL_CAL_POINTER GROUP BY TBL_CAL_POINTER.TFID PIVOT TBL_CAL_POINTER.TPOS")
    Set C_RCST_DAO_POINTER_COLOR = CurrentDb.OpenRecordset("TRANSFORM First(TBL_CAL_POINTER.TCOLOR) AS C SELECT TBL_CAL_POINTER.TFID FROM TBL_CAL_POINTER GROUP BY TBL_CAL_POINTER.TFID PIVOT TBL_CAL_POINTER.TPOS")
  End If
  If bolShow = True Then
    sSql = "SELECT * FROM TBL_CAL_MEETING WHERE TID=" & lID
    'Achtung: Hier 4 angeben für Anlegen eines neuen Termins
    CAL_OpenForm "FRM_CAL_MEETING", , , , , , 4 & "~" & sSql & "~" & lID
  End If
End Function

Wenn Du ein neues Meeting mit bestimmten Parametern anlegen möchtest und dieses gleich im Meeting-Formular anzeigen willst, verwende den folgenden Aufruf:

Public Sub Test_CreateNewMeeting_Param_MitAnzeige()
    Call CreateNewMeeting_Parameter("Subject", "Body", "Location", Now, Now + 1 / 48)
End Sub

Wenn Du den Termin einfach so anlegen möchtest, ohne das der Termin in seinem Formular angezeigt wird, nutzt Du diesen Aufruf:

Public Sub Test_CreateNewMeeting_Param_OhneAnzeige()
    Call CreateNewMeeting_Parameter("Subject", "Body", "Location", Now, Now + 1 / 48, False)
End Sub