Как получить повторяющиеся встречи из календаря Outlook с помощью Excel VBA? - PullRequest
Новая
       73

Как получить повторяющиеся встречи из календаря Outlook с помощью Excel VBA?

0 голосов
/ 15 сентября 2018

Я пытаюсь воссоздать приглашения из календаря Outlook в Excel.

У меня есть таблица с интервалом в 15 минут, представленная в виде ячейки в Excel, и моя цель - заполнить ее встречами, которые у меня есть.запланировано.

Мне удалось скопировать все неповторяющиеся встречи, отнесенные к категории «Подтвержденные» и продолжительностью 15 минут.(Я также могу получить те, которые имеют продолжительность 30, 45 и 60 минут, но я не включил их, чтобы упростить прилагаемый код).

Я хотел бы добавить повторяющиеся встречи.

Свойство .IncludeRecurrenes недоступно для Excel (для Outlook).

Я предпочитаю не экспортировать календарь из Outlook, так как было бы проще просто запустить макрос.

Мои знания ограничены, и я не нашел много в Интернете, связанных с Excel. 

Sub Copy_Calendar()

Dim o As Outlook.Application
Set o = New Outlook.Application

Dim ons As Outlook.Namespace
Set ons = o.GetNamespace("MAPI")

Dim myfol As Outlook.Folder
Set myfol = ons.GetDefaultFolder(olFolderCalendar)

Dim myapt As Outlook.AppointmentItem

Dim row_number As Long
row_number = 2

Dim meeting_start

Dim FromDate As Date
Dim ToDate As Date
FromDate = CDate("07/01/2019")
ToDate = CDate("11/01/2019")

For Each myapt In myfol.Items

If (myapt.Start >= FromDate And myapt.Start <= ToDate) Then

Do
DoEvents
row_number = row_number + 1

meeting_start = DateValue(Sheet1.Range("B" & row_number)) + Sheet1.Range("C" & row_number)

If myapt.Categories = "Confirmed" Then
    If myapt.Start = meeting_start Then
        If myapt.Duration = 15 Then
        'Cells(row_number, 1) = "Confirmed"
        Exit Do
        End If       
    End If
End If
Loop Until row_number = 187
row_number = 2

End If

Next
Set o = Nothing
Set ons = Nothing
Set myfol = Nothing
Set myapt = Nothing

End Sub
...