Problème ajout de rendez-vous outlook

Bonjour à tous,

J'ai un souci avec la création de rendez-vous sur Outlook à partir d'Excel

J'ai une liste de dates sur lesquelles je boucle pour la création de rendez-vous.

Le souci c'est qu'uniquement la dernière date est prise en compte dans la création de rendez-vous.

Sub NouveauRDV_Calendrier()

Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim ws As Worksheet, i As Integer

Set Rdv = OkApp.CreateItem(olAppointmentItem)
Set sw = Worksheets("rendezvous")

For i = 2 To plage Step 1
    With Rdv
        .MeetingStatus = olMeeting
        .Subject = "Hotline 1"
        .Body = "Rappel Hotline 1"
        .Location = "UPI"
        .Start = ws.Range("A" & i).Value & " 7:30"
        .Duration = 540
        .Categories = "Hotline 1"
        .Recipients.Add ("azerty@outlook.com")
        .ReminderSet = True
        .Save

    End With
Next i

Set OkApp = Nothing
End Sub

Bonjour,

For i = 2 to plage ' step 1 est la valeur par défaut rien ne sert de le mentionner.

Mais, plage équivaut à quoi ????????

Tu as oublié d'en définir la valeur.

Gelinotte

A oui en effet à force de faire des modification .

voici le code d'origine

Sub NouveauRDV_Calendrier()

Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim ws As Worksheet, i As Integer, plage As Long

Set Rdv = OkApp.CreateItem(olAppointmentItem)
Set ws = Worksheets("rendezvous")
plage = ws.Range("A" & Rows.Count).End(xlUp).Row
MsgBox plage
For i = 2 To plage Step 1
    With Rdv
        .MeetingStatus = olMeeting
        .Subject = "Hotline 1"
        .Body = "Rappel Hotline 1"
        .Location = "UPI"
        .Start = ws.Range("A" & i).Value & " 7:30"
        .Duration = 540
        .Categories = "Hotline 1"
        .Recipients.Add ("azerty@outlook.com")
        .ReminderSet = True
        .Save

    End With
Next i

Set OkApp = Nothing
End Sub

Merci pour l'aide j'ai compris mon erreur en faite il fallait que je créer l'objet "Set Rdv = OkApp.CreateItem(olAppointmentItem)"dans la boucle.

Sub NouveauRDV_Calendrier()

Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim ws As Worksheet, i As Integer, plage As Long

Set ws = Worksheets("rendezvous")
plage = ws.Range("A" & Rows.Count).End(xlUp).Row
MsgBox plage
For i = 2 To plage Step 1
Set Rdv = OkApp.CreateItem(olAppointmentItem)
    With Rdv
        .MeetingStatus = olMeeting
        .Subject = "Hotline 1"
        .Body = "Rappel Hotline 1"
        .Location = "UPI"
        .Start = ws.Range("A" & i).Value & " 7:30"
        .Duration = 540
        .Categories = "Hotline 1"
        .Recipients.Add ("azerty@outlook.com")
        .ReminderSet = True
        .Save

    End With
Next i

Set OkApp = Nothing
End Sub

Bonjour,

À tester ...

Sub NouveauRDV_Calendrier()

Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim ws As Worksheet, i As Integer, plage As Long

Set ws = Worksheets("rendezvous")
plage = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To plage
   Set Rdv = OkApp.CreateItem(olAppointmentItem)
   With Rdv
      .MeetingStatus = olMeeting
      .Subject = "Hotline 1"
      .Body = "Rappel Hotline 1"
      .Location = "UPI"
      .Start = ws.Range("A" & i).Value & " 7:30"
      .Duration = 540
      .Categories = "Hotline 1"
      .Recipients.Add ("azerty@ook.com")
      .ReminderSet = True
      .Save
    End With
Next i
Set OkApp = Nothing
End Sub

Gelinotte