Modificat° fichier envoi E-mail Outlook express par WINDOWS MAIL

tennis

XLDnaute Nouveau
Bonjour,

J'avais trouvé ce fichier très utile qui me permettait d'envoyer des emails avec pièces jointes en utilisant OUTLOOK EXPRESS.

Serait il possible de le modifier pour que la macro fonctionne désormais avec WINDOWS MAIL (de préférence) et/ou outlook 2000-2003 voire 2007....

Merci à tous
 

Pièces jointes

  • Sami_EnvoiEMail_Outlook - Copie.zip
    8.5 KB · Affichages: 157

Staple1600

XLDnaute Barbatruc
Re : Modificat° fichier envoi E-mail Outlook express par WINDOWS MAIL

Bonjour


EDITION : testé sous Vista avec WinMail
Cela fonctionne (il faut que WinMAil soit le client messagerie par défaut)
Les adresses mail sont en colonne B

(auteur du code: John Walkenbach)
Code:
[FONT=Courier New][COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Declare[/COLOR] [COLOR=darkblue]Function[/COLOR] ShellExecute [COLOR=darkblue]Lib[/COLOR] "shell32.dll" _
Alias "ShellExecuteA" ([COLOR=darkblue]ByVal[/COLOR] hwnd [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], [COLOR=darkblue]ByVal[/COLOR] lpOperation [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
ByVal lpFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], [COLOR=darkblue]ByVal[/COLOR] lpParameters [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], [COLOR=darkblue]ByVal[/COLOR] lpDirectory [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
ByVal nShowCmd [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]) [COLOR=darkblue]As[/COLOR] Long

[COLOR=darkblue]Sub[/COLOR] SendEMail()
    [COLOR=darkblue]Dim[/COLOR] Email [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], Subj [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] Msg [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], URL [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] r [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR], x [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Double[/COLOR]
    [COLOR=darkblue]For[/COLOR] r = 2 [COLOR=darkblue]To[/COLOR] 4 [COLOR=green]'data in rows 2-4[/COLOR]
[COLOR=green]'       Get the email address[/COLOR]
        Email = Cells(r, 2)
        
[COLOR=green]'       Message subject[/COLOR]
        Subj = "Your Annual Bonus"

[COLOR=green]'       Compose the message[/COLOR]
        Msg = ""
        Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
        Msg = Msg & "I am pleased to inform you that your annual bonus is "

        Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "William Rose" & vbCrLf
        Msg = Msg & "President"
        
[COLOR=green]'       Replace spaces with %20 (hex)[/COLOR]
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
                
[COLOR=green]'       Replace carriage returns with %0D%0A (hex)[/COLOR]
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

[COLOR=green]'       Create the URL[/COLOR]
        URL = "mailto:" & Email & "?subject=" & [COLOR=darkblue]Sub[/COLOR]j & "&body=" & Msg

[COLOR=green]'       Execute the URL (start the email client)[/COLOR]
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

[COLOR=green]'       Wait two seconds before sending keystrokes[/COLOR]
        Application.Wait (Now + TimeValue("0:00:02"))
        Application.SendKeys "%s"
    [COLOR=darkblue]Next[/COLOR] r
[COLOR=darkblue]End[/COLOR] Sub[/FONT]

 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 305
Messages
2 087 088
Membres
103 461
dernier inscrit
dams94