基于 SharePoint 日历条目创建个人日历条目

Question

我正在尝试阅读我的 Sharepoint 日历条目，然后在我的个人日历中添加一个在同一天 4 小时的节日。

以下创建了一个新条目，但我的 For Each 循环似乎不起作用，因为当我尝试使用从变量“newStart”读取的日期和时间创建一个新条目时，它总是跳回主函数。

Public newStart As String
    
Sub ReadEntries()
    Dim oApp As Outlook.Application
    
    On Error Resume Next
    ' check if Outlook is running
    Set oApp = GetObject("Outlook.Application")
    If Err <> 0 Then
        'if not running, start it
        Set oApp = CreateObject("Outlook.Application")
    End If
    
    Set olApp = New Outlook.Application
    Set olFldr = olApp.GetNamespace("MAPI").Folders("Other Calendars").Folders("FOLDERNAME")
        
    For Each Items In olFldr
        If olFldr.Items.Subject = "Given Entry Title" Then
            newStart = olFldr.Items.Start
            CreateStandby
        End If
    Next
                
    Set oObject = Nothing
    Set oApp = Nothing
    
End Sub
    
    
Sub CreateStandby()
    
    Dim standbyEntry As Object
     
    Set standbyEntry = Application.CreateItem(olAppointmentItem)
    standbyEntry.Subject = "New Entry Title"
    standbyEntry.Start = newStart
    standbyEntry.Duration = 240
    standbyEntry.BusyStatus = olOutOfOffice
    standbyEntry.Send
    standbyEntry.Save
     
End Sub

Answer 1

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

' Avoid global variables unless there is no other way
'  Inevitably the name will be non-unique
'  You need something impossible to reproduce in other code
' Public newStart As String

Sub ReadEntries()

    Dim olfldr As folder
    Dim myItem As Object
    
    ' The less good version of GetObject was incorrectly done.
    ' Must return to regular error handling. On Error GoTo 0
    '
    ' This shows the ideal, one line only, error bypass.
    ' https://stackoverflow.com/questions/22059917/how-to-verify-outlook-session-is-open-or-not-using-vba
    '
    ' Unnecessary when code is in Outlook.
    
    Set olfldr = Session.folders("Other Calendars").folders("FOLDERNAME")
    
    For Each myItem In olfldr.Items
    
        If myItem.Class = olAppointment Then
        
            If myItem.subject = "Given Entry Title" Then
                CreateStandby myItem.Start, myItem.Duration
            End If
            
        End If
    Next
    
End Sub


Sub CreateStandby(itmStart As Date, itmDuration As Long)

    Dim standbyEntry As AppointmentItem

    Set standbyEntry = CreateItem(olAppointmentItem)

    With standbyEntry
        .subject = "New Entry Title"
    
        ' start 4 hours earlier
        .Start = DateAdd("h", -4, itmStart)
    
        ' end at the same time
        .Duration = itmDuration + 240
    
        .Display
    End With

End Sub