会社で使用しているスケジュール管理のがOutlookなんだが、ようわからんが何をどう頑張ってもポップアップが出ないようにされているようだ。
ノートパソコン持ち歩くようになったので顧客に別の顧客の個人情報見えたらやばいってことかな？

で、内勤のワタクシ。何を隠そうめちゃくちゃ物忘れが激しいわけですよ。何を頼まれても３回は忘れるんですよ！！！（その度依頼者と互いに嫌な思いをして習慣化する）

これはいかん、と思いまして、今日と明日のスケジュールを取得したい、と。（次のステップとしては選択したスケジュールを送信時間指定してメールしたい）
エクセルちゃんから参照設定でOutlookを追加しておいてね。

こちらを参考に
[Outlook マクロ] 予定表に登録されている予定を取得する – Tk2Kpdn Wiki

コンナンエクセル方に書いて

Public Sub CreateDailyMail()
Dim ap As Outlook.Application
Set ap = Outlook.Application
Dim l_calendar As Outlook.Folder
Set l_calendar = ap.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
Dim l_appointments As Outlook.Items
Set l_appointments = l_calendar.Items
Dim s As String: s = Format(Date, "yyyy/m/d 0:00")
Dim e As String: e = Format(Date, "yyyy/m/d 23:59")
Set l_appointments = l_appointments.Restrict( _
"(([Start] = '" & s & "') And ([AllDayEvent] = True)) Or " & _
"(([Start] >= ' & s & ') And ([End] < ' & e & '))")
Dim l_appointment As Outlook.AppointmentItem
Dim i As Long: i = 1
Dim j As Long
For Each l_appointment In l_appointments
j = 1
Cells(i, j) = l_appointment.Start: j = j + 1
Cells(i, j) = l_appointment.Subject: j = j + 1
Cells(i, j) = l_appointment.Body: j = j + 1
Cells(i, j) = l_appointment.AllDayEvent
i = i + 1
Next
End Sub

こうかな？　と

こんな感じの予定表があるとするじゃないですか。

RUN！

なんでやねん！！！

こ、公式～！！　助けてよぉ～

定期的な予定を含め、今日と明日に発生する予定の件名を表示します

https://docs.microsoft.com/ja-jp/office/vba/api/outlook.items.includerecurrences

RestrictじゃなくてFindとFindNextでぐるぐるしろってことか？

Sub DemoFindNext()
Dim ap As Outlook.Application
Set ap = Outlook.Application
Dim tdystart As String
Dim tdyend As String
Dim myAppointments As Outlook.Items
Dim currentAppointment As Outlook.AppointmentItem
tdystart = Format(Date, "yyyy/m/d 0:00")
tdyend = Format(Date + 1, "yyyy/m/d 23:59")
Set myAppointments = _
ap.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar).Items
myAppointments.Sort "[Start]"
myAppointments.IncludeRecurrences = True
Set currentAppointment = myAppointments.Find("[Start] >= """ & _
tdystart & """ and [Start] <= """ & tdyend & """")
Dim i As Long: i = 1
Dim j As Long
While TypeName(currentAppointment) <> "Nothing"
j = 1
Cells(i, j) = currentAppointment.Start: j = j + 1
Cells(i, j) = currentAppointment.Subject: j = j + 1
Cells(i, j) = currentAppointment.Body: j = j + 1
Cells(i, j) = currentAppointment.AllDayEvent
i = i + 1
Set currentAppointment = myAppointments.FindNext
Wend
End Sub

ＯＫ！！((２２日の１１時からの予定が終日になってたので修正しました(；´Д｀)))