Загрузка данных из Excel в Outlook

[lorents]

Добрый день!
У меня есть таблица Excel. И там есть Столбец с датами и временем (в ячейках).
Как можно загрузить эти данные в календарь Outlook, т.е надо просканировать все ячейки определенного столбца, и ввести информацию в в календарь Outlook. Главное чтобы это работало через Outlook.

У меня есть код

Код: Выделить всё

sub AddToOutlook()  
   
'!! Reference to Excel object library required !!  
   
    Dim olAppointment As Outlook.AppointmentItem  
    Dim olApp As Excel.Application  
    Dim lngRow As Long, shtSource
   
   
    'Get reference to MS excel
    On Error Resume Next  
    Set olApp = GetObject(, "Excel.Application")  
    If Err.Number <> 0 Then  
        Set olApp = CreateObject("Excel.Application")  
    End If  
   
    On Error GoTo 0  
  set wb=olApp.openworkbook("C:\1.xls")
set shtSource=wb.sheets(1)
       
   
        Set olAppointment = application.CreateItem(olAppointmentItem)  
 .
        With olAppointment  
  Subject = shtSource.cells(1,1)
.Location ="место где происходит задача"  
.Start = Cdate("Дата/время задачи")  
            .Save  
        End With  
   
   
End Sub  

И еще один вопрос, как сделать чтобы таблица Excel сканировалась, каждые 10 минут и вводила изменения в календарь Outlook.
Спасибо за внимание!

[lorents]

С первым вопросом разобрался

Код: Выделить всё

Sub AddToOutlook()
'!! Reference to Excel object library required !!
    Dim olAppointment As Outlook.AppointmentItem
    Dim olApp As Excel.Application
    Dim lngRow As Long, shtSource
    'Get reference to MS excel
    On Error Resume Next
    Set olApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set olApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set wb = olApp.Workbooks.Open("C:\1.xls")
    Set shtSource = wb.sheets(1)
    For i = 1 To 50
        If shtSource.cells(i, 1) = "" Then
            Exit For
        End If
    Set olAppointment = Application.CreateItem(olAppointmentItem)
    With olAppointment
    .Subject = shtSource.cells(i, 1)
    .Location = shtSource.cells(i, 3)
    .Start = CDate(shtSource.cells(i, 2))
    .Body = shtSource.cells(i, 4)
    .Save
    End With
Next i
wb.Close
End Sub

Теперь осталось понять, как вводить новые и измененные пункты?

[lorents]

Придумал один способ, как мне ввести новые и измененные значения в Outlook

Удалить все значения в календаре, и вставить новые, но сделать так чтобы Outlook не напоминал, если дата и время прошли.
ни как не могу сообразить как сделать?