Option Explicit

Private Sub Application_Startup()
Const strWorkBook As String = "C:\Path\Meetings.xlsx" 'The workbook with the dates
Const strSheet As String = "Sheet1"
Dim objNS As Outlook.NameSpace
Dim strDate As String
Dim strDate1 As String
Dim strDate2 As String
Dim Arr() As Variant
Dim iCols As Long
Dim iRows As Long

    Set objNS = GetNamespace("MAPI")
    strDate = "01" & Format(Date, "/MM/YYYY")
    Arr = xlFillArray(strWorkBook, strSheet)
    For iRows = 0 To UBound(Arr, 2)
        If CDate(strDate) = Arr(0, iRows) Then
            If Arr(3, iRows) = True Then
                MsgBox "No meeting update required"
                GoTo lbl_Exit
            Else
                strDate1 = Arr(1, iRows)
                strDate2 = Arr(2, iRows)
                Call NewMeeting(CDate(strDate1), CDate(strDate2))
                Call UpdateLog(strWorkBook, strSheet, strDate)
            End If
        End If
    Next iRows
lbl_Exit:
    Exit Sub
End Sub

Private Function xlFillArray(strWorkBook As String, _
                             strWorksheetName As String) As Variant
Dim RS As Object
Dim CN As Object
Dim iRows As Long

    strWorksheetName = strWorksheetName & "$]"
    Set CN = CreateObject("ADODB.Connection")
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkBook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1

    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.GetRows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function

Option Explicit

Public Sub NewMeeting(Date1 As Date, Date2 As Date)
Dim olMeeting1 As Object, olMeeting2 As Object
Dim olRequiredAttendee As Recipient
Dim olOptionalAttendee As Recipient
Dim olResourceAttendee As Recipient
Dim StartTime As Date
Dim lngDuration As Long
Const strLocation As String = "Conference Room"
Const strSubject As String = "Strategy Meeting"

    Set olMeeting1 = Application.CreateItem(olAppointmentItem)
    StartTime = "09:00"
    lngDuration = 90         'minutes
    With olMeeting1
        .MeetingStatus = olMeeting
        .Subject = strSubject
        .Location = strLocation
        .Start = Date1 & Chr(32) & StartTime
        .Duration = lngDuration
        'Required attendees
        Set olRequiredAttendee = .Recipients.Add("Graham Mayor")
        olRequiredAttendee.Type = olRequired
        Set olRequiredAttendee = .Recipients.Add("Bill Bloggs")
        olRequiredAttendee.Type = olRequired
        'Optional attendees
        'Set olOptionalAttendee = .Recipients.Add("John Smith")
        'olOptionalAttendee.Type = olOptional
        'Resource attendees
        'Set olResourceAttendee = .Recipients.Add("Fred Jones")
        'olResourceAttendee.Type = olResource
        .Display
        '.sEnd 'restore after testing
    End With
    
    Set olMeeting2 = Application.CreateItem(olAppointmentItem)
    StartTime = "13:00"
    lngDuration = 120 'minutes
    With olMeeting2
        .MeetingStatus = olMeeting
        .Subject = strSubject
        .Location = strLocation
        .Start = Date2 & Chr(32) & StartTime
        .Duration = lngDuration
        'Required attendees
        Set olRequiredAttendee = .Recipients.Add("Graham Mayor")
        olRequiredAttendee.Type = olRequired
        Set olRequiredAttendee = .Recipients.Add("Bill Bloggs")
        olRequiredAttendee.Type = olRequired
        'Optional attendees
        'Set olOptionalAttendee = .Recipients.Add("John Smith")
        'olOptionalAttendee.Type = olOptional
        'Resource attendees
        'Set olResourceAttendee = .Recipients.Add("Fred Jones")
        'olResourceAttendee.Type = olResource
        .Display
        '.sEnd 'Restore after testing
    End With
lbl_Exit:
    MsgBox "Meetings created"
    Exit Sub
End Sub

Public Sub UpdateLog(strWorkBook As String, strSheet As String, strDate As String)
Dim xlApp As Object
Dim xlWB As Object
Dim xlRange As Object
Dim xlCell As Object
Dim bStarted As Boolean

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
        bStarted = True
    End If
    On Error GoTo 0
    Set xlWB = xlApp.Workbooks.Open(strWorkBook)
    With xlWB.Sheets(strSheet)
        Set xlCell = .Cells.Find(strDate)
        If Not xlCell Is Nothing Then
            If Not xlCell Is Nothing Then
                MsgBox "Log updated"
                xlCell.Offset(0, 3).Value = True
            Else
                MsgBox "Date not found"
            End If
        End If
    End With
    xlWB.Close SaveChanges:=True 'Remove while testing
    If bStarted Then
        xlApp.Quit
        Set xlApp = Nothing
        Set xlWB = Nothing
    End If
lbl_Exit:
    Exit Sub
End Sub