Envoi de tache sur agenda Outlook

Bonjour à tous

Je suis débutant en VBA et j'essaie de créer des codes d'après vos différents exemples.

J'ai crée un userform qui me permet de remplir les données au fur et a mesure en ajoutant les lignes et pour finir en envoyant sur outlook une tache dans mon agenda.

Mon problème est qu'à chaque nouvelle ligne cela envoie les taches de toutes les lignes existantes dans le tableau, j'aimerai qu'elle ne lance que la nouvelle ligne, je vous joins mon code et un tableau d 'exemple

Merci pour votre aide

Private Sub CommandButton1_Click()
Dim i As Integer
i = Range("a100").End(xlUp).Row + 1
Range("a" & i) = UCase(TextBox1)
Range("b" & i) = TextBox2
Range("c" & i) = UCase(TextBox3)
Range("d" & i) = UCase(TextBox4)
Range("e" & i) = TextBox5
TextBox1 = " "
TextBox2 = " "
TextBox3 = " "
TextBox4 = " "
TextBox5 = " "

Set ws = Sheets("feuil1")
Set outlook = CreateObject("Outlook.Application")
dl = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To dl 'on parcourt la liste des tâches
Set tache = outlook.CreateItem(3) 'nouvelle tâche
With tache
.Subject = "Client : " & ws.Cells(i, 1) & " Compagnie : " & ws.Cells(i, 3)
.DueDate = ws.Cells(i, 2) 'date de l'envoi
.Status = 3 ' en attente
.Importance = 1 'normale
.ReminderSet = True
.ReminderTime = ws.Cells(i, 5) 'date du rappel
.Body = "Envoi de la lettre de résiliation auprès " & ws.Cells(i, 4) & " pour le contrat n° " & ws.Cells(i, 3) & " du client " & ws.Cells(i, 1)
.Save
End With
Next i
End Sub

Bonjour,

Tu pourrais rajouter une colonne dans ton tableau, avec "OK" pour les taches déjà créés.

La macro chercherait sur chaque ligne la présence du OK ou non, et ne créerait la tâche que si le OK n'est pas trouvé.

Merci de ton conseil mais comment le mentionner dans le code si je crée une colonne de plus

Merci de ton aide

Je suis sur téléphone, je ne peux pas regarder le fichier.

Si jamais personne n'a répondu d'ici là, j'essaierai de regarder demain. Mais je ne promets rien.

Mais ce sont des modifications mineures à faire (en théorie). Si tu as compris le code que tu utilises, tu dois pouvoir l'adapter.

Ok mais mes compétences sont très très limites

J'essaie ...

Merci

À part réussir et progresser, que risques-tu ? ^^

Bon, à chaque essai ça risque de te faire un max de tâches à effacer. Mais ça vaut le coup 😂

c'est pas gagné...........

Mon Cher Joyeux Noel

Si tu as du temps à perdre je suis preneur car je vais passer la nuit en vain je crois.....

Bonjour,

Voici le code modifié :

Private Sub CommandButton1_Click()
Dim i As Integer
Dim Ws As Worksheet
Dim Outlook As Object
i = Range("a100").End(xlUp).Row + 1
Range("a" & i) = UCase(TextBox1)
Range("b" & i) = TextBox2
Range("c" & i) = UCase(TextBox3)
Range("d" & i) = UCase(TextBox4)
Range("e" & i) = TextBox5

Set Ws = Sheets("feuil1")
Set Outlook = CreateObject("Outlook.Application")
dl = Ws.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To dl    'on parcourt la liste des tâches
        If Cells(i, 6) <> "OK" Then
            Set tache = Outlook.CreateItem(3)    'nouvelle tâche
            With tache
                .Subject = "Client : " & Ws.Cells(i, 1) & " Compagnie : " & Ws.Cells(i, 3)
                .DueDate = Ws.Cells(i, 2)    'date de l'envoi
                .Status = 3    ' en attente
                .Importance = 1    'normale
                .ReminderSet = True
                .ReminderTime = Ws.Cells(i, 5)    'date du rappel
                .Body = "Envoi de la lettre de résiliation auprès  " & Ws.Cells(i, 4) & " pour le contrat n° " & Ws.Cells(i, 3) & " du client " & Ws.Cells(i, 1)
                .Save
            End With
Cells(i, 6) = "OK"
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
        Else: End If
    Next i
End Sub

Il te suffit de rajouter la colonne F, comme ici.

Salut Joyeux Noel et merci beaucoup,

J'étais dans la bonne direction mais je me compliquais énormément les choses

En tout cas je te remercie de ta disponibilité et de ton aide

Bonne journée.

Re,

Alors, petites précisions quand même, ton userform en l'état actuel des choses n'apporte pas grand chose et la solution que je t'ai proposée est bancale.

Si tu veux enregistrer plein de lignes à la suite et créer tes nouvelles tâches en une seule fois, tu peux te passer de ton userform et le code deviendrait ça (code à attribuer à ton bouton, et à mettre dans un module standard)

Sub creer_taches()
Dim i As Integer
Dim Ws As Worksheet
Dim Outlook As Object
i = Range("a100").End(xlUp).Row

Set Ws = Sheets("feuil1")
Set Outlook = CreateObject("Outlook.Application")
dl = Ws.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To dl    'on parcourt la liste des tâches
        If Cells(i, 6) <> "OK" Then
            Set tache = Outlook.CreateItem(3)    'nouvelle tâche
            With tache
                .Subject = "Client : " & Ws.Cells(i, 1) & " Compagnie : " & Ws.Cells(i, 3)
                .DueDate = Ws.Cells(i, 2)    'date de l'envoi
                .Status = 3    ' en attente
                .Importance = 1    'normale
                .ReminderSet = True
                .ReminderTime = Ws.Cells(i, 5)    'date du rappel
                .Body = "Envoi de la lettre de résiliation auprès  " & Ws.Cells(i, 4) & " pour le contrat n° " & Ws.Cells(i, 3) & " du client " & Ws.Cells(i, 1)
                .Save
            End With
Cells(i, 6) = "OK"
        Else: End If
    Next i
End Sub

Si par contre, tu veux vraiment passer par ton userform et créer les tâches individuellement, ceci devrait suffire en fait, pas besoin de passer par la colonne OK :

Private Sub CommandButton1_Click()
Dim i As Integer
Dim Ws As Worksheet
Dim Outlook As Object
i = Range("a100").End(xlUp).Row + 1
Range("a" & i) = UCase(TextBox1)
Range("b" & i) = TextBox2
Range("c" & i) = UCase(TextBox3)
Range("d" & i) = UCase(TextBox4)
Range("e" & i) = TextBox5

Set Ws = Sheets("feuil1")
Set Outlook = CreateObject("Outlook.Application")
Set tache = Outlook.CreateItem(3)    'nouvelle tâche
        With tache
           .Subject = "Client : " & Ws.Cells(i, 1) & " Compagnie : " & Ws.Cells(i, 3)
           .DueDate = Ws.Cells(i, 2)    'date de l'envoi
           .Status = 3    ' en attente
           .Importance = 1    'normale
           .ReminderSet = True
           .ReminderTime = Ws.Cells(i, 5)    'date du rappel
           .Body = "Envoi de la lettre de résiliation auprès  " & Ws.Cells(i, 4) & " pour le contrat n° " & Ws.Cells(i, 3) & " du client " & Ws.Cells(i, 1)
           .Save
       End With

TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
End Sub

Tu es mon maitre .........

Top Merci

Oh non, je ne suis le maître de personne. Et je n'ai fait qu'adapter le code existant ...