Microsoft 365 Vba Excel l'instruction Set OutApp = CreateObject("Outlook.Application") bloque excel

[guy trioreau]

Bonjour,

Je suis en train d'écrire un module VBA Excel pour envoyer des Email à une liste de personnes contenues dans un onglet d'une autre fichier Excel.
Je me suis basé sur vos tutoriels et ceux d'autres sites. La plupart des exemples utilisent l'instruction Set OutApp = CreateObject("Outlook.Application").
Je rencontre systématiquement un problème à l'exécution de cette instruction, avec le message suivant :

Voici un exemple de code :

Sub Mail_small_Text_Outlook()
'For Tips see: https://jkp-ads.com/rdb/win/winmail/Outlook/tips.htm

'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
Voici un exemple de code que j'ai testé :

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Je vous remercie de m'indiquer si vous savez comment résoudre mon problème.

Cordialement

 

[Staple1600]

Bonsoir le fil

@guy trioreau
La PJ avec le message d'erreur n'est pas passé.
Il faudrait la joindre de nouveau
(en faisant Modifier)

 

[laurent950]

Bonsoir @guy trioreau

Remplacer juste cette ligne :
Set OutApp = CreateObject("Outlook.Application")
par toutes ces lignes et rien d'autres dans votre code

On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If OutApp Is Nothing Then
        Set OutApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0