XL 2016 Macro pour envoyer un mail par Outlook

[MOEZ-TUN]

bonjour
j'ai adapter un macro pour envoyer un mail et ça marche très bien, lorsque le Outlook de la récepteur est fermer ne fonctionne pas?
voici mon macro:


'---http://www.vbaexpress.com/kb/getarticle.php?kb_id=758
'--- pas d'ouverture / fermeture OUTLOOK

Dim blRunning As Boolean

'get application
blRunning = True
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
With olMail
'Specify the email subject
.Subject = "My email with attachment"
'Specify who it should be sent to
'Repeat this line to add further recipients
.To = "Mohamed-moez.bali@onetech-group.com"
'.Recipients.Add "xxx@yahoo.com" 'name@host.com"
'specify the file to attach
'repeat this line to add further attachments
.Attachments.Add "D:\Scaling\envoyeur.xlsx"
'specify the text to appear in the email
.Body = "Here is an email"
'Choose which of the following 2 lines to have commented out
'.Display 'This will display the message for you to check and send yourself
.Send ' This will send the message straight away
End With

If Not blRunning Then olApp.Quit

Set olApp = Nothing
Set olMail = Nothing

End Sub

 

[BigA]

Bonsoir,
Voici ce que je vous propose, le premier code est le vôtre avec quelques corrections et le second est le code comment je l'aurais fait. Les deux fonctionnent avec toutes les versions d'Outlook, ouvert ou fermé.

Sub SendMail()

    Dim olApp As Object
    Dim olMail As Object

    On Error Resume Next

    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    
    With olMail
        'Specify the email subject
        .Subject = "My email with attachment"
        'Specify who it should be sent to
        'Repeat this line to add further recipients
        .To = "Mohamed-moez.bali@onetech-group.com"
        '.Recipients.Add "xxx@yahoo.com" 'name@host.com"
        'specify the file to attach
        'repeat this line to add further attachments
        .Attachments.Add "D:\Scaling\envoyeur.xlsx"
        'specify the text to appear in the email
        .Body = "Here is an email"
        'Choose which of the following 2 lines to have commented out
        .Display 'This will display the message for you to check and send yourself
'        .Send ' This will send the message straight away
    End With


    Set olApp = Nothing
    Set olMail = Nothing

End Sub

Sub EnvoyerUnMail()

    Dim olApp As Object, olMail As Object
    
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    
    With olMail
        
        .BodyFormat = 2     'Format de l'e-mail
        .Display            'Affiche le mail avant de l'envoyer
        
        .HTMLBody = "Here is an email"
        .Attachments.Add "D:\Scaling\envoyeur.xlsx"
        
        .To = "Mohamed-moez.bali@onetech-group.com;xxx@yahoo.com"   'Pour ajouter des personnes il suffit d'ajouter un point-virgule après les adresses
        '.CC = "xxx@yahoo.com"      'Ajouter destinataire en copie
        '.BCC = "xxx@yahoo.com"     'Copie chachée
        .Subject = "My email with attachment"
        
        '.Send      'Envoie le mail sans l'afficher
        
    End With
    
    Set olApp = Nothing
    Set olMail = Nothing

End Sub

Cordialement,
Moi