Outlook - Excel'den Outlook Takvime Veri Aktarımı

[b]Excel[/b]'den [b]Outlook[/b] Takvime makro ile veri aktarımı için şu kodları kullanabilirsiniz;

Sub Outlook_Takvime_Olay_Ata()
    Dim EvnOUT As Object,OutRandevu As Object,say As Long
    say = 0
    For s = 6 To Range("C65536").End(xlUp).Row
    If Range("B" & s) <> "OK" Then
    
    On Error Resume Next
    Set EvnOUT = GetObject(, "Outlook.Application")
    If Err.Number = 429 Then
        Set EvnOUT = CreateObject("Outlook.application")
    End If
    On Error GoTo 0
    Set OutRandevu = EvnOUT.CreateItem(olAppointmentItem)
    On Error Resume Next
        With OutRandevu
            .Start = Range("C" & s) + Range("D" & s)
            .End = Range("E" & s) + Range("F" & s)
            .Subject = Range("G" & s)
            .Location = Range("H" & s)
            .Body = Range("I" & s)
            If Len(Range("J" & s)) > 0 Then
                If IsNumeric(Range("J" & s)) Then
                    .ReminderMinutesBeforeStart = Range("J" & s)
                    .ReminderSet = True
                End If
            End If
            If Err <> 0 Then
                Range("B" & s) = "HATA"
            Else
                .Save
                Range("B" & s) = "OK"
                Err = 0
                say = say + 1
            End If
        End With
    
'    OutRandevu.Display
    Set EvnOUT = Nothing
    Set OutRandevu = Nothing
    End If
    Next s
    If say > 0 Then
        MsgBox say & " adet kayıt aktarıldı.", vbInformation, "ExcelVba.Net"
    Else
        MsgBox "Aktarılan kayıt yok!", vbExclamation, "ExcelVba.Net"
    End If
End Sub

[b]Hoşça kalın ! [/b]