1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
|
Option Explicit
Sub Outlook_Email(adresse As String, password As String, destinataire As String)
Dim objOutlookApp As Object
Dim objNamespace As Object
Dim objMailItem As Object
' Créer une instance de l'application Outlook
On Error Resume Next
Set objOutlookApp = CreateObject("Outlook.Application")
If objOutlookApp Is Nothing Then
MsgBox "L'application Outlook n'est pas disponible.", vbExclamation
Exit Sub
End If
On Error GoTo 0
' Accéder au Namespace (espace de noms) Outlook
Set objNamespace = objOutlookApp.GetNamespace("MAPI")
' Connexion au compte Outlook
objNamespace.Logon adresse, password
' Créer un nouvel objet de message
Set objMailItem = objOutlookApp.CreateItem(0)
' Définir les paramètres du message (destinataire, sujet, corps, expéditeur)
With objMailItem
.To = destinataire
.Subject = "Mon objet......"
.Body = "Le texte de mon message ............"
.Send ' Envoyer l'e-mail
End With
' Nettoyer les objets
Set objMailItem = Nothing
objNamespace.Logoff
Set objNamespace = Nothing
Set objOutlookApp = Nothing
End Sub
Sub Appeler_Outlook_Email()
Dim adresse As String
Dim password As String
Dim destinataire As String
adresse = Sheets("Admin").Range("A1").Value
password = Sheets("Admin").Range("A2").Value
destinataire = "asso92.blp@gmail.com"
Outlook_Email adresse, password, destinataire
End Sub |
Partager