MS-Oulook macro lors nouveau mail ... XL

[tora]

Bonjour a tous,

Avec Ms-Outlook, quelques petits soucis ... ( la fin du parcours c'est XL )

Je souhaiterais :

1/ tout comme sous XL créer un bouton avec un smiley jaune en image
de fond (c'est possible ça ?)

2/Lors de la création d'un nouveau mail : récupérer l'adresse mail et
la rebalancer dans un fichier XL avec quelques commentaires choisis
dans d'autres colonnes, etc ... (lancé par mon smiley car action non
souhaitée sur tous les mails sortants)

Pour explication :
A partir d'une page Web ou l'on trouve une adresse mail (nous contacter : "moi@moi.com") ,
en cliquant sur l'adresse mail, Ms-Outlook s'ouvre avec un nouveau mail prêt à l'envoi qui est
donc porteur de l' adresse mail convoitée, attendant qu'on lui remplisse le contenu et l'envoyer.

Bref mon smiley va glaner ici : "moi@moi.com" et ouvrir mon fichier XL
pour continuer à le remplir .... mais bien sur ce mail ne sera pas envoyé et
détruit en fin de macro après <<glannage>>.

Merci d'avance pour votre attention !!!

 

[JNP]

Re : MS-Oulook macro lors nouveau mail ... XL

Salut Tora ,
Comme ça, on se lance dans les macros OutLook ? Bon courage car c'est souvent la prise de tête ...

1/ tout comme sous XL créer un bouton avec un smiley jaune en image
de fond (c'est possible ça ?)
Solution la plus simple, créer une barre d'outil personnalisée, choisir l'affichage icône et dessiner un beau petit smyley.
2/Lors de la création d'un nouveau mail : récupérer l'adresse mail et
la rebalancer dans un fichier XL avec quelques commentaires choisis
dans d'autres colonnes, etc ... (lancé par mon smiley car action non
souhaitée sur tous les mails sortants)
Là, à mon avis, moins cool... Si j'ai un peu compris les macros que j'ai écrit pour OutLook, le principe est toujours de créer l'observateur d'évènement, puis de lui affecter des tâches en fonction de l'événement déclenché. La barre d'outil décrite plus haut, je ne suis pas sûr que tu puisses l'affecter à la rédaction du mail, à la place du menu principal (je ne peux pas vérifier, sur 2007, la rédaction est en mode ruban).
Pour explication :
A partir d'une page Web ou l'on trouve une adresse mail (nous contacter : "moi@moi.com") ,
en cliquant sur l'adresse mail, Ms-Outlook s'ouvre avec un nouveau mail prêt à l'envoi qui est
donc porteur de l' adresse mail convoitée, attendant qu'on lui remplisse le contenu et l'envoyer.
Bref mon smiley va glaner ici : "moi@moi.com" et ouvrir mon fichier XL
pour continuer à le remplir .... mais bien sur ce mail ne sera pas envoyé et
détruit en fin de macro après <<glannage>>.
C'est peut-être là qu'est la solution : déclencher l'observateur sur l'événement : ne pas envoyer (plus exactement Voulez-vous enregistrer les modifications, soit l'événement Before_Close de Nouveau Message)

Au passage, il y a une section pour les messages autres applis qu'Excel, et pour le smiley, jette un oeil à ce fil de Stapple.
Bon courage

 

[tora]

Re : MS-Oulook macro lors nouveau mail ... XL

Salut JNP,

Oui : la prise de tronche je te confirme ... mais je ne fais que passer
je ne compte pas m'y spécialiser.

le smiley j'ai pas forcément besoin qu'il soit jaune même vert c bon

non je déconne l'image de fond est pas le sujet.
Mais un simple bouton a moi, on est d'accord sur le point que à la
différence d' XL sous Outlook impossible de le rajouter manuellement
( au dessus de barre de menu clic droit > personnaliser ... recherche
bouton non programmé + drag & drop ) ???
Pour les ajouts de nouveau menu/boutons sous outlook c encore l'inconnu
pour moi.

si c'était possible, je pourrai déjà avancer un peu la chose quoi ...
actuellement j'essaye de réfléchir à une manière de faire à partir
de l'évènement Application_ItemSend à défaut de mieux ...
(une idée dans la manche qui le fera peut-être d'ailleurs)

Bref je vais essayer encore quelques recherches mais je trouve pas
vraiment; en général les sujets sont des soucis de XL envoi mail par Outlook
pas mon sujet actuel ...

Bref à plus tard ! Merci

PS : a propos du fil de stapple, c fun a tester une fois mais franchement
comme dit Roger : bien du boulot pour pas grand choz ... et tout comme
Bruno m'attendait a autre chose surtout en comparaison de la quantité
de code ... bref ... retour à ma laine ( et mes moutons ) ... bêêêê ....

 

[JNP]

Re : MS-Oulook macro lors nouveau mail ... XL

Re ,
Teste cela

Public WithEvents myItem As Outlook.MailItem
Public Sub Initalize_Handler()
    Set myItem = Application.ActiveInspector.CurrentItem
End Sub
Private Sub myItem_Close(Cancel As Boolean)
    If Not myItem.Saved Then
           MsgBox " Voulez-vous stocker l'adresse ?"
           MsgBox myItem.To
    End If
End Sub

et dis moi.
Bon courage

 

[tora]

Re : MS-Oulook macro lors nouveau mail ... XL

Hello JNP

Bon j'avais vaguement vu passer l'inspecteur au fil de mes recherches
mais avec mon idée de base j'arrive à peu près à me décrotter ...

Donc je procède sur le Item_send Event en mettant dans le body
un texte bidon : xl qui me sert de password au lancement macro.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If UCase(Item.Body) = "XL" Then
        Call Process(Item)
        Cancel = True
    End If
End Sub

Par contre là ou je blok actuellement voilou :

Private Sub Process(Item)
    On Error Resume Next
    Dim AppXL As Object, wkb, Rg, Act As Boolean, Rep As Long
    Dim Ou As String, Fichier As String

    Ou = "C:\Documents and Settings\Utilisateur\Mes documents\"
    Fichier = "mails.xls"    
    Act = False
    
    Set AppXL = CreateObject("Excel.Application")
    Set wkb = AppXL.Workbooks.Open(Ou & Fichier)
    
    If TypeName(wkb) = "Empty" Then
        MsgBox "Le fichier " & Fichier & vbCrLf & "contenant les Contacts n'est pas à l'emplacement prévu :" & _
                vbCrLf & Ou, vbCritical, "Erreur - Action Annulée": Act = False
    Else        
        With wkb.sheets(1)
            Set Rg = .cells.Find(Item.To)
            
            If Not Rg Is Nothing Then
                Rep = MsgBox("Adresse trouvée la cellule " & Replace(Rg.Address, "$", "") & " contient : " & _
                              Rg.Value & vbCrLf & vbCrLf & "Poursuivre l'Enregistrement ??", vbInformation + _
                              vbYesNo + vbDefaultButton2, "Adresse à Insérer : " & Item.To)
                If Rep = vbYes Then Act = True
            Else
                Act = True
            End If
            
[COLOR="Red"]            Rep = 0
            If Act Then
                Rep = .Range("A65536").End(xlUp).Row + 1
                
                MsgBox "action = Ligne " & Rep
            End If[/COLOR]            
        End With
    End If
    
    wkb.Close
    
    Set AppXL = Nothing
    
    Item.Delete
End Sub

Et donc ma variable Rep reste à 0, impossible de lui faire cracher
le bon numéro de ligne fin de colonne A ... saleté va !
Bref le fait que l'objet AppXL ne lance pas XL je me demande si ce n'est pas
la source de mes mots .... au fait la variante :
Rep = .cells(65536, 1).End(xlUp).Row + 1 c idem ya rien de mieux.

une idée pour trouver la dernière ligne remplie colonne A ?

merci

 

[tora]

Re : MS-Oulook macro lors nouveau mail ... XL

si j'ai une solution:

do
....
loop while

si pas mieux déjà avec ça on peut faire tourner la bourrique !

 

[JNP]

Re : MS-Oulook macro lors nouveau mail ... XL

Re ,
Une alternative à End dans ce post.
A +

 

[tora]

Re : MS-Oulook macro lors nouveau mail ... XL

Re

oui JNP effectivement ta recette prend bien ! le gateau gonfle !

j'arrive à obtenir ma ligne d'action correcte en fin de colonne A :

wkb.sheets(1).UsedRange.Row + wkb.sheets(1).UsedRange.Rows.Count

Par contre surement du a la différence de version, on s'est pris un
bug dans le item.body ... 2 lettre tapées mais un contenu de 4
durant inspection .... chr(13) ou retour charriot me semble-t-il plus
un 4e inconnu ... le code asc() n'est pas sorti ? ....

Bref ... un petit mid() pour arrondir le compte du tirage ...

Puis une dernière épreuve nous est tombé dessus :
Si j'ai oublié de fermer XL et le fichier ou outlook va aller inscrire
des données, bing je mange le bug erreur 1004 ...

Toi qui regorges de bonnes recettes ... encore une petite ?

Merci encore !

 

[JNP]

Re : MS-Oulook macro lors nouveau mail ... XL

Re ,
Une petite, NON ...
Trouvé dans l'aide

GetObject, fonction, exemple

Cet exemple utilise la fonction GetObject pour obtenir une référence à une feuille de calcul Microsoft Excel spécifique (MyXL). Il utilise la propriété Application de la feuille de calcul pour rendre Microsoft Excel visible, pour fermer l'application, etc. Le premier appel à la fonction GetObject entraîne une erreur si Microsoft Excel n'est pas déjà en exécution. Dans notre exemple, l'erreur a pour conséquence d'attribuer la valeur True à l'indicateur ExcelWasNotRunning. Le deuxième appel à la fonction GetObject indique le fichier à ouvrir. Si Microsoft Excel n'est pas déjà en exécution, le deuxième appel lance l'application et renvoie une référence à la feuille de calcul représentée par le fichier indiqué, montest.xls. Ce fichier doit se trouver à l'emplacement spécifié ; dans le cas contraire, l'erreur Erreur Automation Visual Basic est générée. L'exemple de code rend ensuite Microsoft Excel et la fenêtre contenant la feuille de calcul indiquée visibles. Enfin, si Microsoft Excel n'était pas en exécution précédemment, le code utilise la méthode Quit de l'objet Application pour fermer Microsoft Excel. Si l'application était déjà en exécution, le code ne tente pas de la fermer. La référence elle-même est libérée en recevant la valeur Nothing.
' Déclare les routines d'API nécessaires
Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName as String, _
ByVal lpWindowName As Long) As Long
Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd as Long, ByVal wMsg as Long, _
ByVal wParam as Long, _
ByVal lParam As Long) As Long
Sub GetExcel()
Dim MyXL As Object
' Variable devant contenir la
' référence à Microsoft Excel.
Dim ExcelWasNotRunning As Boolean
' Indicateur de libération finale.
' Test pour déterminer si une copie de Microsoft Excel' est déjà en exécution.
On Error Resume Next
' Retarde la récupération d'erreur.
' La fonction Getobject appelée sans le premier
' argument renvoie une référence à une instance de
' l'application. Si l'application n'est pas en
' exécution, une erreur se produit.
Set MyXL = Getobject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear
' Efface l'objet Err si une erreur s'est produite.
' Vérifie si Microsoft Excel est en exécution.
' Dans ce cas, l'ajoute à la table
Running Object.DetectExcel
' Définit la variable objet faisant référence au fichier à ouvrir.
Set MyXL = Getobject("c:\vb5\MONTEST.XLS")
' Affiche Microsoft Excel par l'intermédiaire de sa
' propriété Application. Affiche ensuite la fenêtre
' contenant le fichier à l'aide de la collection
' Windows de la référence à l'objet MyXL.
MyXL.Application.Visible = True
MyXL.Parent.Windows(1).Visible = True
' Effectue des opérations sur votre
' fichier ici.
' ...
' Si cette copie de Microsoft Excel n'était pas en cours
' d'exécution lorsque vous avez commencé, fermez-la
' à l'aide de la méthode Quit de la propriété
' Application.
' Notez que si vous tentez de quitter Microsoft Excel,
' la barre de titre clignote et un message s'affiche
' vous demandant si vous souhaitez enregistrer les
' fichiers chargés.
If ExcelWasNotRunning = True Then MyXL.Application.Quit
End IF
Set MyXL = Nothing
' Libère la référence à l'application
' et à la feuille de calcul.
End Sub
Sub DetectExcel()
' La procédure détecte une instance d'Excel en
' exécution et l'inscrit.
Const WM_USER = 1024
Dim hWnd As Long
' Si Excel est en exécution, cet appel d'API renvoie
' son descripteur.
hWnd = FindWindow("XLMAIN", 0)
If hWnd = 0 Then
' 0 signifie qu'Excel n'était
' pas en exécution.
Exit Sub
Else
' Excel est en exécution, donc utilise la fonction
' d'API SendMessage pour l'entrer dans la table
' Running Object.
SendMessage hWnd, WM_USER + 18, 0, 0
End If
End Sub

Bon courage

 

[tora]

Re : MS-Oulook macro lors nouveau mail ... XL

Salut JNP,

Wow si avec ça on fait pas la lessive et dinner pour le réveillon alors ....

J'ai pas tout comprendu donc je vais y aller a petite dose ...

Mais merci encore !!