Crear tarea repetitiva en outlook desde excel

Tengo esta macro para crear citas desde una tabla de excel pero quiero cambiarla para que en lugar de cita cree una tarea.

Además por ahora la cita que crea es cada año, quisiera que al escribir por ejemplo en la columna 5 en numero 2, la cita sea repetitiva pero cada dos años o 3 según lo que este escrito.

Espero pueda ayudarme.

Gracias

Private Sub cmd_Outlook_Click()
    Dim ol As New Outlook.Application
    Dim ns As Outlook.Namespace
    Dim itmApoint As Outlook.AppointmentItem
    Dim liste As Long
        For liste = 5 To Range("A65536").End(xlUp).Row
            If Cells(liste, 6) = "" Then
                Set itmApoint = ol.CreateItem(olAppointmentItem)
                With itmApoint
                .Start = DateSerial(Year(Cells(liste, 4)), Month(Cells(liste, 4)), Day(Cells(liste, 4)))
                .Subject = Cells(liste, 2)
                .Body = Cells(liste, 1)
                .Importance = olImportanceNormal
                .GetRecurrencePattern = olRecursYearly
                .ReminderMinutesBeforeStart = 10080
                .Save
                End With
                Cells(liste, 6) = "OK"
            End If
    Next liste
End Sub

1 Respuesta

Respuesta
1

No lo he testado, pero prueba:

Private Sub cmd_Outlook_Click()
    Dim ol As New Outlook.Application
    Dim ns As Outlook.Namespace
    Dim itmApoint As Outlook.TaskItem
    Dim liste As Long
        For liste = 5 To Range("A65536").End(xlUp).Row
            If Cells(liste, 6) = "" Then
                Set itmApoint = ol.CreateItem(olTaskItem)
                With itmApoint
                .Start = DateSerial(Year(Cells(liste, 4)), Month(Cells(liste, 4)), Day(Cells(liste, 4)))
                .Subject = Cells(liste, 2)
                .Body = Cells(liste, 1)
                .Importance = olImportanceNormal
                .GetRecurrencePattern.Interval = Cells(liste, 5).Value
                .ReminderMinutesBeforeStart = 10080
                .Save
                End With
                Cells(liste, 6) = "OK"
            End If
    Next liste
End Sub

Aparece error 438 en tiempo de ejecución

Al depurar marca el error en start

 Ese error no entiendo porque salga.Cuando estaba en citas no salia.

Muchas gracias por ayudarme.

Pon

. StartDate

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas