Macro outlook
xshbl a écrit :Je suis vraiment désolé mais a l'ouverture du fichier j'ai une erreur d,execution 2147417851 la methode subject de l'objet taskitem à echoué.
Et j'ai la ligne : .Subject = c surlignée en jaune
Xavier
essayer ce fichier
ps: outlook est bien lancé ?
ti_chou_3 a écrit :xshbl a écrit :Je suis vraiment désolé mais a l'ouverture du fichier j'ai une erreur d,execution 2147417851 la methode subject de l'objet taskitem à echoué.
Et j'ai la ligne : .Subject = c surlignée en jaune
Xavier
essayer ce fichier
ps: outlook est bien lancé ?
c'est le .subject de quel boucle qui est surligné?
xshbl a écrit :Je suis vraiment désolé mais a l'ouverture du fichier j'ai une erreur d,execution 2147417851 la methode subject de l'objet taskitem à echoué.
Et j'ai la ligne : .Subject = c surlignée en jaune
Xavier
et si je laisse le fichier ouvert et que je lance la macro manuellement j'ai " erreur automation Le serveur à généré une exception
tester juste ce code et dites moi si ca passe :
Sub workbook_open()
MsgBox " Lancement de la macro !"
Dim debut
Dim Ol_App As New Outlook.Application
Dim Ol_Mapi As Outlook.Namespace
Dim Ol_Items As Outlook.Items
Dim Ol_Item As Outlook.TaskItem
Set Ol_Mapi = Ol_App.GetNamespace("MAPI")
Set Ol_Items = Ol_Mapi.GetDefaultFolder(olFolderTasks).Items
Dlg = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
der_lign = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
'Definition à la main de ton début
debut = 4
For Each c In Sheets("Feuil1").Range("A" & debut & ":A" & der_lign)
If c.Offset(0, 7) = "X" Then 'tache envoyée sur outlook
i = 0
For Each Ol_Item In Ol_Items
If Ol_Item.Subject = c Then ' si el nom du rappel est une des lignes envoyées à Outlook alors
GoTo Passe2 'on ne fait rien si le rappel existe toujours
End If
i = i + 1
Next Ol_Item
If i = Ol_Items.Count Then
c.Offset(0, 8) = "X" 'on passe la colonne I à X car envoi deja fait - si on passe par la c'est que le rendez vous n'existe plus
End If
End If
Next
Set Ol_Item = Nothing
Set Ol_Items = Nothing
Set Ol_Mapi = Nothing
Set Ol_App = Nothing
End Suboui Outlook ouvert
J'ai la même erreur : subject.......
d'apres la derniere macro lorsque je la lance j'ai une erreur de compilation étiquette non définie
xshbl a écrit :oui Outlook ouvert
J'ai la même erreur : subject.......
dites moi si vous avez :
allez dans visual basic > outils > references
les memes references que moi
Microsoft Excel 14,0 object library
Microsoft outlook 14.0 object library
si non activez les
cdt,
xshbl a écrit :J vous joint les ref
allez sur VB , sur le code faites F8 F8 ca execute pas à pas je voudrais savoir a quel endroit il plante.
cdt,
Bonjour
Désolé mais hier, il a fallu que je reparte.
Je joint une capture d'image sur l'erreur lorsque je fait F8.
J'ai essayé le dernier fichier, lorsque je clic sur le bouton rien ne se passe et pas d'erreur !
Merci
cdt
Xavier
xshbl a écrit :Bonjour
Désolé mais hier, il a fallu que je reparte.
Je joint une capture d'image sur l'erreur lorsque je fait F8.
J'ai essayé le dernier fichier, lorsque je clic sur le bouton rien ne se passe et pas d'erreur !
Merci
cdt
Xavier
ok aviez vous des taches crees?
Merci de creer deux taches sur outlook puis relancer le dernier fichier
cdt,
Re
J'ai crée deux taches dans Outlook une à la dte d'aujourd'hui et l'autre à demain. Lorsque je clic sur le bouton du fichier rien ne se passe.
cdt
xshbl a écrit :Re
J'ai crée deux taches dans Outlook une à la dte d'aujourd'hui et l'autre à demain. Lorsque je clic sur le bouton du fichier rien ne se passe.
cdt
bizarre je jetterai un oeil ce soir
Sub workbook_open()
MsgBox " Lancement de la macro !"
Dim MyOut As New Outlook.Application
Dim MyTassk As TaskItem
Dim debut
Dlg = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
der_lign = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
Set mytask2 = MyOut.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks).Items
For Each MyTassk In mytask2
MsgBox MyTassk
Next
End Subbonsoir
Merci de tester ce code en ayant des taches crées
cdt,
Bonsoir Ti_chou_3
Désolé hier j'était malade ,je suis tombé à 21h00.
J'ai essayé ton dernier code, j'ai une fenêtre qui s'ouvre avec "lancement de la macro" puis une fenêtre qui reprend le titre de ma tache, une autre pour la deuxième tache mais une fois fini, je n'ai rien d'affiché ! Ca c'est avec le pc de mon boulot.
Chez moi, j'ai "lancement de la macro" puis "incompatibilité de type" je pense que cela est du au fait que j'ai configuré Outlook pour gmail !
En se qui concerne reprendre les taches de Outlook vers le fichier, pas grave , ne vous prenez pas la tête...... en tout cas c'est très sympas.
cdt
Xavier
xshbl a écrit :Bonsoir Ti_chou_3
Désolé hier j'était malade ,je suis tombé à 21h00.
J'ai essayé ton dernier code, j'ai une fenêtre qui s'ouvre avec "lancement de la macro" puis une fenêtre qui reprend le titre de ma tache, une autre pour la deuxième tache mais une fois fini, je n'ai rien d'affiché ! Ca c'est avec le pc de mon boulot.
Chez moi, j'ai "lancement de la macro" puis "incompatibilité de type" je pense que cela est du au fait que j'ai configuré Outlook pour gmail !
En se qui concerne reprendre les taches de Outlook vers le fichier, pas grave , ne vous prenez pas la tête...... en tout cas c'est très sympas.
cdt
Xavier
C est normal le but etait de tester la recup de vos taches.
Peux tu tester le code avc ton pc de boulot ou je t indiquais que c etait bon.
A tester mettre date ds echeance a hier
regarder si tache se creee
regarder si x se met
supprimer tache
regarder si second x apparait
Celui ci
Sub workbook_open()
MsgBox " Lancement de la macro !"
Dim MyOut As New Outlook.Application
Dim MyTassk As TaskItem
Dim debut
Dim Ol_App As New Outlook.Application
Dim Ol_Mapi As Outlook.Namespace
Dim Ol_Items As Outlook.Items
Dim Ol_Item As Outlook.TaskItem
Set Ol_Mapi = Ol_App.GetNamespace("MAPI")
Set Ol_Items = Ol_Mapi.GetDefaultFolder(olFolderTasks).Items
Dlg = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
der_lign = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
'Definition à la main de ton début
debut = 4
'analyse tâches inscrites sur outlook mais deja réalisés
For Each c In Sheets("Feuil1").Range("A" & debut & ":A" & der_lign)
If c.Offset(0, 7) = "X" Then 'tache envoyée sur outlook
i = 0
For Each Ol_Item In Ol_Items
If Ol_Item.Subject = c Then ' si el nom du rappel est une des lignes envoyées à Outlook alors
GoTo Passe2 'on ne fait rien si le rappel existe toujours
End If
i = i + 1
Next Ol_Item
If i = Ol_Items.Count Then
c.Offset(0, 8) = "X" 'on passe la colonne I à X car envoi deja fait - si on passe par la c'est que le rendez vous n'existe plus
End If
End If
Next
Passe2:
'on parcours chaque ligne de la colonne A
For Each c In Sheets("Feuil1").Range("A" & debut & ":A" & der_lign)
'on s'assure que la donnée n'est pas vide + colonne H différente de I
If c <> "" And c.Offset(0, 7) <> "X" And c.Offset(0, 5) = Date - 1 Then
'creation de tache imbrique dans boucle
Set mytask = MyOut.CreateItem(olTaskItem)
With mytask
.Subject = c
.Body = "Le décompte envoyé le " & c.Offset(0, 4) & _
" pour la maintenance effectuée sur la commune de " & c & _
" n'a toujours pas été validé par le client, merci de faire une relance"
.Save
End With
'mise a I de la colonne H
c.Offset(0, 7) = "X"
'mise a zero de mytask
Set mytask = Nothing
End If
Next
Set Ol_Item = Nothing
Set Ol_Items = Nothing
Set Ol_Mapi = Nothing
Set Ol_App = Nothing
End subRe bonsoir
Je viens d’essayer, la création des taches à la date d’hier est ok, par contre rien lorsque je l’aient supprimes !
cdt
Ha ! oui une question.
La macro doit être dans module 1 ou thisworkbook
elle se nome bien : send_tache_outlook
Bonsoir
Comme discuté avec toi je suis passé par une fonction pour tester si la tache existe ou non.
Voici le code complet et fonctionnel :
Public Sub workbook_open()
'MsgBox " Lancement de la macro !"
Dim MyOut As New Outlook.Application
Dim MyTassk As TaskItem
Dim Ol_App As New Outlook.Application
Dim Ol_Mapi As Outlook.Namespace
Dim Ol_Items As Outlook.items
Dim Ol_Item As Outlook.TaskItem
Set Ol_Mapi = Ol_App.GetNamespace("MAPI")
Set Ol_Items = Ol_Mapi.GetDefaultFolder(olFolderTasks).items
Dlg = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
der_lign = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
'Definition à la main de ton début
debut = 4
'Plage alerte des échéances ( on fait un >= à date jour - cet intervalle )
intervalle_alerte = 7
'analyse tâches inscrites sur outlook mais deja réalisés
For Each c In Sheets("Feuil1").Range("A" & debut & ":A" & der_lign)
If c.Offset(0, 7) = "X" And c.Offset(0, 8) <> "X" Then
'MsgBox c
'MsgBox message
message = ""
Call existe_tache(c, message) 'appel de la fonction qui checke si la tache existe
If message = "Deleted" Then
c.Offset(0, 8) = "X" 'on passe la colonne I à X car envoi deja fait - si on passe par la c'est que le rendez vous n'existe plus
End If
'MsgBox message
End If
Next
'on parcours chaque ligne de la colonne A
For Each c In Sheets("Feuil1").Range("A" & debut & ":A" & der_lign)
'on s'assure que la donnée n'est pas vide + colonne H différente de I
If c <> "" And c.Offset(0, 7) <> "X" And c.Offset(0, 5) >= Date - intervalle_alerte Then
'creation de tache imbrique dans boucle
Set mytask = MyOut.CreateItem(olTaskItem)
With mytask
.Subject = c
.Body = "Le décompte envoyé le " & c.Offset(0, 4) & _
" pour la maintenance effectuée sur la commune de " & c & _
" n'a toujours pas été validé par le client, merci de faire une relance"
.Save
End With
'mise a I de la colonne H
c.Offset(0, 7) = "X"
'mise a zero de mytask
Set mytask = Nothing
End If
Next
End Sub
Public Function existe_tache(c, message) ' Fonction qui checke l'existence de la tache dans les elements excels de la colonne a
'Dim c, message
Dim MyOut As New Outlook.Application
Dim MyTassk As TaskItem
Dim Ol_App As New Outlook.Application
Dim Ol_Mapi As Outlook.Namespace
Dim Ol_Items As Outlook.items
Dim Ol_Item As Outlook.TaskItem
Set Ol_Mapi = Ol_App.GetNamespace("MAPI")
Set Ol_Items = Ol_Mapi.GetDefaultFolder(olFolderTasks).items
message = ""
If Ol_Items.Count = 0 Then
'si plus aucun message alors inutile de comparer :-) -- tout est deleted par raisonnement
Message = "Deleted"
GoTo fin:
End If
'MsgBox Ol_Item.Count
For Each Ol_Item In Ol_Items
If c = Ol_Item.Subject Then
sujet = Ol_Item.Subject
Else
sujet = ""
End If
If sujet = c Then
message = "not deleted"
GoTo fin
Else
message = "Deleted"
End If
Next
fin:
End FunctionBonsoir Ti_chou_3
Je suis passé cette après midi à mon boulot pour essayer ton dernier code et la croix en colonne I ne se met pas !
cdt
Xavier
xshbl a écrit :Bonsoir Ti_chou_3
Je suis passé cette après midi à mon boulot pour essayer ton dernier code et la croix en colonne I ne se met pas !
cdt
Xavier
Date de fichier superieure a j-7 et rdv supprime?
Bonsoir
Oui j'ai supprimé toues les croix d'hier et les taches dans Outlook, j'ai relancé le fichier, il m'a refait toutes les taches dans Outlook, j'ai refermé le fichier, supprimé quelques taches et relancé le fichier. Aucune croix dans la colonne I
cdt
xshbl a écrit :Bonsoir
Oui j'ai supprimé toues les croix d'hier et les taches dans Outlook, j'ai relancé le fichier, il m'a refait toutes les taches dans Outlook, j'ai refermé le fichier, supprimé quelques taches et relancé le fichier. Aucune croix dans la colonne I
cdt
testes ce fichier.
A faire :
Lancer macro via bouton crée
Les RDV vont se créer
Supprimer deux rdv
relancer la macro
re
Désolé mais toujours rien en colonne I
cdt