none
Access->Outlook Kalenderexport

    Frage

  • Hallo,

    ich möchte per VBA aus Access einen Termin in einem Outlook-Kalender (nicht dem Standardkalender) anlegen und suche dafür einen fertigen Code, weil ich einfach nicht weiter komme. Es soll Late Binding sein und den Zugriff auf einen bestimmten Kalender enthalten. Hat jemand zufällig eine passende Lösung?

    Freitag, 2. Februar 2018 18:52

Alle Antworten

  • Vorbei bringen oder holst du das ab?
    Donnerstag, 22. Februar 2018 13:59
  • Ganz grobe Richtung zum gucken

    LateBinding und Zuweisung vom Kalender sind drin

    Dim objOutl As Object    ' Outlook.Application
    Dim olNameSpace As Object  ' Outlook.NameSpace
    Dim oMAPIFolder As Object ' Outlook.MAPIFolder
    Dim objTermin As Object    ' Outlook.KalenderItem
    Dim Ordner As Object
    
    Const olFolderCalendar = 9
        
    On Error Resume Next
    Set objOutl = CreateObject("Outlook.Application")
    
    ' Namespace initialisieren
    Set olNameSpace = objOutl.GetNamespace("MAPI")
    
    'Welcher Kalender in Outlook
    If GBKalenderOrdnerEins = "" Then
            Set oMAPIFolder = olNameSpace.GetDefaultFolder(olFolderCalendar)
        Else
            Set Ordner = olNameSpace.Folders.item(GBKalenderOrdnerEins)
            Set oMAPIFolder = Ordner.Folders.item(GBKalenderOrdnerZwei)
    End If
    
    On Error GoTo 20
    'Vorhandenen Termin bearbeiten
    If eid <> "" Then
        WelcheEntryID = eid
        If IsNull(olNameSpace.GetItemFromID(eid)) Then
                
               Else
                Dim app As Object
                Set app = olNameSpace.GetItemFromID(eid)
                DoEvents
                With app
                    .Subject = Nz(Subject, "")
                    .Body = Nz(Body, "")
                    .Location = Nz(Location, "")
                    .Start = Nz(StartDateTime, "")
                    .End = Nz(EndDateTime, "")
                    .ReminderMinutesBeforeStart = Nz(ReminderMinutesBeforeStart.Column(1), 0)
                    .BusyStatus = Nz(BusyStatus, "")
                    .Importance = Nz(ImportanceLevel, "")
                    .Categories = Nz(cmbLabel, "")
                     If IsMeeting = 0 Then
                          Else
                          .MeetingStatus = True
                     End If
                     If IsReminder = 0 Then .ReminderSet = False Else .ReminderSet = True
                     If IsPrivate = 0 Then .Sensitivity = 0 Else .Sensitivity = 2
                     If IsAllDayEvent = 0 Then .AllDayEvent = False Else .AllDayEvent = True
                    .Save
                End With
                Set app = Nothing
                GoTo 10
        End If
    End If
    
    On Error Resume Next
    20:
    
    'Neuen Termin anlegen
    Set objTermin = oMAPIFolder.Items.Add
    If Not objTermin Is Nothing Then
        With objTermin
          .Subject = Nz(Subject, "")
          .Body = Nz(Body, "")
          .Location = Nz(Location, "")
          .Start = Nz(StartDateTime, "")
          .End = Nz(EndDateTime, "")
          .ReminderMinutesBeforeStart = Nz(ReminderMinutesBeforeStart.Column(1), 0)
          .BusyStatus = Nz(BusyStatus, "")
          .Importance = Nz(ImportanceLevel, "")
          .Categories = Nz(cmbLabel, "")
           If IsMeeting = 0 Then
                Else
                .MeetingStatus = True
           End If
           If IsReminder = 0 Then .ReminderSet = False Else .ReminderSet = True
           If IsPrivate = 0 Then .Sensitivity = 0 Else .Sensitivity = 2
           If IsAllDayEvent = 0 Then .AllDayEvent = False Else .AllDayEvent = True
          .Save
          WelcheEntryID = .EntryID
        End With
        Else
    End If
    
    10
    Set objTermin = Nothing
    Set objOutl = Nothing

    Mittwoch, 28. Februar 2018 09:23