Kan ik excel koppelen aan outlook 365

Sub ImportCalendar()
Dim NextRow As Integer, LeadDate As Date, DueDate As Date, Subject As String, Location As String, Body As String
    
    For NextRow = 2 To 3
        With Sheets("Blad1")
            Subject = .Cells(NextRow, "H").Value
            LeadDate = .Cells(NextRow, "A").Value + .Cells(NextRow, "C").Value
            DueDate = .Cells(NextRow, "B").Value + .Cells(NextRow, "D").Value
            LeadDate = .Cells(NextRow, "A").Value + .Cells(NextRow, "C").Value
            Location = .Cells(NextRow, "F").Value
            Body = .Cells(NextRow, "H").Value
        End With
        CreateCalEntry LeadDate, DueDate, Subject, Location, Body
    Next NextRow
End Sub

Function CreateCalEntry(LeadDate As Date, DueDate As Date, Subject As String, Location As String, Body As String)
Const olApItem = 1
Dim apOL As Object 'Outlook.Application, oItem As Object 'Outlook.AppointmentItem, objFolder As Object 'MAPI Folder '

    Set apOL = CreateObject("Outlook.Application")
    Set objFolder = GetFolder("Public Folders/All Public Folders/Shared Calender")
    Set oItem = apOL.CreateItem(olApItem)
    With oItem
        .Subject = Subject
        .Location = Location
        .Body = Body
        If IsDate(LeadDate) Then
            .Start = LeadDate
        Else
            .Start = DueDate
        End If
        .End = DueDate
        .Display
    End With

    Set oItem = Nothing
    Set apOL = Nothing
End Function

Public Function GetFolder(strFolderPath As String) As Object
'http://www.outlookcode.com/d/code/getfolder.htm '
Dim apOL As Object 'Outlook.Application '
Dim objNS As Object 'Outlook.NameSpace '
Dim colFolders As Object 'Outlook.Folders '
Dim objFolder As Object 'Outlook.MAPIFolder '
Dim arrFolders() As String
Dim I As Long

    strFolderPath = Replace(strFolderPath, "/", "\")
    arrFolders() = Split(strFolderPath, "\")
    Set apOL = CreateObject("Outlook.Application")
    Set objNS = apOL.GetNamespace("MAPI")
    On Error Resume Next
    Set objFolder = objNS.Folders.Item(arrFolders(0))
    If Not objFolder Is Nothing Then
        For I = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(I))
            If objFolder Is Nothing Then
                Exit For
            End If
        Next
    End If
    Set GetFolder = objFolder
    Set colFolders = Nothing
    Set objNS = Nothing
    Set apOL = Nothing
End Function