Create personal Calendar entry based on SharePoint Calendar entry - vba

Question

I'm trying to read my Sharepoint Calendar entries and then add one to my personal calendar with an offest of 4 hours on the same day.
The following creates a new entry but my For Each loop doesn't seem to work as it always jumps back to the main Function when I try to create a new Entry with the Date and Time read from the Variable "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