Makro ile Appointment Oluşturma Konusunda Yardım

[esnmz]

Merhaba,
yaptığım işleri, gittiğim seyahatleri outlook takvimde gösterebilmek için appointment giriyorum. Makro ile mail gönderildiğini biliyorum ancak appointment set etmek imkanı var mıdır?
Makro yazmayı bilmediğim için bu konuda sizden yardım istiyorum.
A2 hücresine yazdığım bilgi "Subject" alanına, B2 hücresine yazdığım bilgi "Location" alanına, C2 hücresine yazdığım tarih "satart time" ve "end time"a gelsin, "all day event" olarak randevu oluştursun istiyorum.
Örnek dosyayı daekledim.
Yardımcı olan olmayan herkese teşekkür ederim.

 

[esnmz]

Günceldir.

 

[esnmz]

şöyle bir makro buldum ve bunu biraz değiştirip istediğim gibi yaptım ancak sadece son satırdaki veriyi işliyor. doılu olan tüm satırları oluşturmak üzere makroyu güncelleyebilir misiniz?

 

[askm]

Aşağıdaki şekilde deneyin.

Sub OutLook_Takvime_Olay_Ata()

    Dim oOutLook As Object
    Dim oAppointment As Object

    On Error Resume Next
    Set oOutLook = GetObject(, "Outlook.Application")
    If Err.Number = 429 Then
        Set oOutLook = CreateObject("Outlook.application")
    End If
    On Error GoTo 0

    
    
    For i = 6 To Cells(501, 3).End(xlUp).Row
    Set oAppointment = oOutLook.CreateItem(olAppointmentItem)

    On Error Resume Next
        With oAppointment
            .Start = Cells(i, 3)
            .Subject = Cells(i, 7)
            .AllDayEvent = True
            .Location = Cells(i, 8)
            .Categories = Cells(i, 9)
                                
            If Err <> 0 Then
                Cells(i, 2) = "HATA"
            Else
                .Save
                Cells(i, 2) = "OK"
                Err = 0
            End If
        End With
    Next i
    
'    oRandevu.Display
     
    Set oOutLook = Nothing
    Set oAppointment = Nothing
End Sub