Envoyer un mail avec Windows mail sous Vista

Avec Vista, outlook express a été remplacé par windows mail. Comment utiliser ce programme pour envoyer un mail depuis excel ?

sub MailAvecOEouWinMail()
 Dim Dest As String
 Dim Sujt As String
 Dim Msg As String
 
 Dest = "coucou@monfai.fr"
 Sujt = "Test d'envoi avec Excel"
 Msg = "Bonjour, Excel vous envoie un message avec "
 On Error Resume Next
 Err.Clear
 Shell Environ("ProgramFiles") & "Outlook Expressmsimn.exe " & _
 "/mailurl:mailto:" & Dest & "?subject=" & Sujt & "&Body=" & Msg & "OE"
 If Err.Number > 0 Then ' Erreur 53 sous Vista : Fichier non trouvé
  Err.Clear
  Shell Environ("ProgramFiles") & "Windows MailWinMail.exe " & _
  "/mailurl:mailto:" & Dest & "? subject=" & Sujt & "&Body=" & Msg &
 "WinMail"
 End If
 On Error GoTo 0
 end sub

Pour info, si on fait démarrer => Exécuter => msimn sous Vista, ça lance bien WinMail, grâce à la clé du registre :

HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionAppPathsmsimn.exe

dont la valeur par défaut est

%ProgramFiles%Windows MailWinMail.exe

On peut donc écrire un procédure plus générique :

sub MailAvecOEouWinMail1()
 Dim WshShell As Object
 Dim Dest As String
 Dim Sujt As String
 Dim Msg As String
 Dim MailProg As String
 Dim Env As String, Pos As Integer
 
 Set WshShell = CreateObject("WScript.Shell")
 MailProg = WshShell.RegRead _
 ("HKLMSOFTWAREMicrosoftWindowsCurrentVersionApp Pathsmsimn.exe")
 Set WshShell = Nothing
 Pos = InStrRev(MailProg, "%")
 If Pos > 0 Then
  Env = Environ(Mid(MailProg, 2, Pos - 2))
  MailProg = Mid(MailProg, Pos + 1)
 End If
 
 Dest = "coucou@monfai.fr"
 Sujt = "Test d'envoi avec Excel"
 Msg = "Bonjour, Excel vous envoie un message avec " & _
     IIf(InStr(MailProg, "msimn") > 0, "OE", "WinMail")
 Shell Env & MailProg & " /mailurl:mailto:" & Dest & "?subject=" & _
    Sujt & "&Body=" & Msg
 end sub

Auteur :

Mots clefs associés à cette page : , ,