Envoie mail par excel2003 via outlook2003

Résolu
lyricshorus Messages postés 3 Date d'inscription jeudi 27 septembre 2007 Statut Membre Dernière intervention 26 septembre 2008 - 15 févr. 2008 à 09:43
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 - 15 févr. 2008 à 10:50
Salut,

Voilà j'ai un problème avec le code qui va suivre mais d'abord je m'explique. 
Je veux envoyer un mail par Outlook 2003 via un Commandbutton d'une userform sous excel 2003. Le problème est que la 1ère fois que je le lance, ça marche. Mais, lorsque je recommence l'opération une 2ème fois, il laisse la fenêtre Outlook ouverte (avec tout le texte dedans) et n'envoie pas le message. Je débute dans le VBA et il y surement quelque chose qui m'échappe. J'ai pris ce code sur ce site.
Je vous remercie d'anvance pour votre aide.

'----------------------------------------------------------------------------------------------------------------------
Sur la Userform
'----------------------------------------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()


    EnvoiEmail Adresse:="[mailto:zzzzzz@yyyy.xxx zzzzzz@yyyy.xxx]", Objet:="Sujet", Corps:="le message", PJ:="", Cc:="", Bcc:="", collage:=False
    
    Userform.Hide



End Sub




'----------------------------------------------------------------------------------------------------------------------
Dans un Module
'----------------------------------------------------------------------------------------------------------------------


Option Explicit



Dim TouchesPJ(5) As String, TouchesEnvoi(5) As String

'----------------------------------------------------------------------------------------------------------------------
Sub EnvoiEmail(Adresse As String, Objet As String, Corps As String, Optional PJ As String, Optional Cc As String, Optional Bcc As String, Optional collage As Boolean)



    Dim HyperLien As String
    Dim i As Integer
    Dim Client As Integer


HyperLien = "mailto:" & Adresse & "?"
HyperLien = HyperLien & "Subject=" & Objet 
    
    If Not collage Then   ' (en cas de collage, le corps est ajouté juste avant le collage)
        HyperLien = HyperLien & "&Body=" & Corps    ' le & sépare les arguments
    End If


    If Cc <> "" Then HyperLien = HyperLien & "&cc=" & Cc
   
    If Bcc <> "" Then HyperLien = HyperLien & "&bcc=" & Bcc

ActiveWorkbook.FollowHyperlink HyperLien
       
Attendre 2



    If collage Then
        ' colle puis insère le texte du message au début du message
        SendKeys "+{INSERT}", True  ' collage
        SendKeys "^{HOME}", True    ' début du message
        SendKeys Corps, True        ' envoi du corps du message
        SendKeys "{Enter}", True    ' ligne suivante
    End If


Client = 3



    Select Case Client
   
        Case 1
            OutLookExpress
        Case 2
            MozillaThunderbird
        Case 3
            Office2003OutLook
        Case 4
            Office2003OutLookV2
        Case 5
            Incredimail
        Case 6
            Office2007OutLook
        Case 7
            Office2000OutLook
        Case Else
            MsgBox "Aucun client de messagerie connu n'est indiqué"
            Exit Sub
    End Select



' Le traitement de la pièce jointe ne s'exécute que si la procédure à reçu qqchose
' dans l'argument PJ (Optional<=>Facultatif)


    If PJ <> "" Then
        For i = 1 To TouchesPJ(0)   ' dans TouchesPJ(0) on a stocké le nombre de touches
                                    ' à envoyer au programme pour joindre une pièce
            SendKeys TouchesPJ(i), True     ' Envoie les touches d'ajout d'1 pièce jointe
            Attendre 1                        ' temporise (à règler éventuellement)
        Next i
        SendKeys PJ, True       ' A ce stade le programme Attend un nom de fichier
                                ' on lui envoie
        Attendre 1                ' on temporise
        SendKeys "{ENTER}", True    ' et on valide ce nom de fichier
        Attendre 1
    End If


    For i = 1 To TouchesEnvoi(0)
        SendKeys TouchesEnvoi(i), True  ' on envoie le message
    Next i

End Sub

'----------------------------------------------------------------------------------------------------------------------
Sub Attendre(Secondes As Integer)
' Cette procédure temporise pendant le nombre de secondes qu'on lui transmet en argument



Dim Début As Long, Fin As Long, Chrono As Long


Début = Timer
Fin = Début + Secondes


    Do Until Timer >= Fin
        DoEvents
    Loop



End Sub





'----------------------------------------------------------------------------------------------------------------------


Sub
OutLookExpress()


'Initialisation des tableaux de touches pour Outlook Express

    ' Pour une pièce jointe
    TouchesPJ(0) = 2        ' Nombre de touches nécessaires
    TouchesPJ(1) = "%i"     ' Appel du menu Insertion par la touche Alt-i
    TouchesPJ(2) = "p"      ' appel du sous-menu pièce par la touche p
    ' Pour l'envoi du mail
    TouchesEnvoi(0) = 1     ' Nombre de touches nécessaires
    TouchesEnvoi(1) = "%s"  ' Envoi du message avec Alt-s
End Sub

'----------------------------------------------------------------------------------------------------------------------
Sub MozillaThunderbird()
'Initialisation des tableaux de touches pour Mozilla Thunderbird
    ' Pour une pièce jointe
    TouchesPJ(0) = 4        ' Nombre de touches nécessaires
    TouchesPJ(1) = "{F10}"     ' Appel des menus par {F10}
    TouchesPJ(2) = "f"     ' Appel du menu Fichier par la touche f
    TouchesPJ(3) = "j"      ' appel du sous-menu Joindre par la touche j
    TouchesPJ(4) = "f"      ' appel du sous-sous-menu Fichier par la touche f
    ' Pour l'envoi du mail
    TouchesEnvoi(0) = 2             ' Nombre de touches nécessaires
    TouchesEnvoi(1) = "^{ENTER}"    ' Envoi du message avec Ctrl-Entrée
    TouchesEnvoi(2) = "{ENTER}"     ' confirmation par Entrée
End Sub

'----------------------------------------------------------------------------------------------------------------------
Sub Office2003OutLook()
'Initialisation des tableaux de touches pour Office Outlook 2003
    ' Pour une pièce jointe
    TouchesPJ(0) = 2        ' Nombre de touches nécessaires
    TouchesPJ(1) = "%i"     ' Appel du menu Insertion par la touche Alt-i
    TouchesPJ(2) = "f"      ' appel du sous-menu fichier par la touche f
    ' Pour l'envoi du mail
    TouchesEnvoi(0) = 1     ' Nombre de touches nécessaires
    TouchesEnvoi(1) = "%v"  ' Envoi du message avec Alt-v
End Sub

'----------------------------------------------------------------------------------------------------------------------
Sub Incredimail()
    ' Initialisation des tableaux de touches pour Incrédimail
    ' Pour une pièce jointe
    TouchesPJ(0) = 1        ' Nombre de touches nécessaires
    TouchesPJ(1) = "^+a"    'Appel du menu Insertion Fichier par la touche Ctrl+Shift+A
    ' Pour l'envoi du mail
    TouchesEnvoi(0) = 1     ' Nombre de touches nécessaires
    TouchesEnvoi(1) = "%s"  'Envoi du message avecAlt-s
End Sub

'----------------------------------------------------------------------------------------------------------------------
Sub Office2003OutLookV2()
    ' Initialisation des tableaux de touches pour Office Outlook 2003
    ' Pour une pièce jointe
    TouchesPJ(0) = 3            ' Nombre de touches nécessaires
    TouchesPJ(1) = "%a"         'Appel du menu Insertion par la touche Alt-a (affichage)
    TouchesPJ(2) = "{RIGHT}"    ' puis flèche à droite
    TouchesPJ(3) = "f"          ' appel du sous-menu fichier par la touche f
    ' Pour l 'envoi du mail
    TouchesEnvoi(0) = 1         ' Nombre de touches nécessaires
    TouchesEnvoi(1) = "%v"      ' Envoi du message avecAlt-v
End Sub

'----------------------------------------------------------------------------------------------------------------------
Sub Office2007OutLook()
    ' Initialisation des tableaux de touches pour Office Outlook 2007
    ' Pour une pièce jointe
    TouchesPJ(0) = 2        ' Nombre de touches nécessaires
    TouchesPJ(1) = "%s"     ' Appel du menu Insertion par la touche Alt-i
    TouchesPJ(2) = "jf"     ' appel du sous-menu fichier par la touche f
    ' Pour l'envoi du mail
    TouchesEnvoi(0) = 1     ' Nombre de touches nécessaires
    TouchesEnvoi(1) = "%v"  'Envoi du message avecAlt-v
End Sub

'----------------------------------------------------------------------------------------------------------------------
Sub Office2000OutLook()
    ' Initialisation des tableaux de touches pour Office Outlook 2000
    ' Pour une pièce jointe
    TouchesPJ(0) = 2 ' Nombre de touches nécessaires
    TouchesPJ(1) = "%i" ' Appel du menu Insertion par la touche Alt-i
    TouchesPJ(2) = "f" ' appel du sous-menu fichier par la touche f
    ' Pour l'envoi du mail
    TouchesEnvoi(0) = 1' Nombre de touches nécessaires
    TouchesEnvoi(1) = "^{ENTER}" ' Envoi du message avec Ctrl-Entrée
End Sub














 

1 réponse

cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
15 févr. 2008 à 10:50
Salut
Si cette source (bien organisée d'ailleurs) vient du site, pose la question à son auteur. Il aura surement la meilleure expérience dans ce domaine.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
3
Rejoignez-nous