Bonjour,
Je souhaite envoyer, depuis Excel, à une liste de diffusion un mail. Après pas mal de recherche, j'ai réussi à écrire le code ci-dessous.
Problème (et là je sèche vraiment) : la commande GetObject(, "Outlook.Application") se met en erreur lorsque Outlook est ouvert (Erreur d'exécution '429 Un composant ActiveX ne peut pas créer d'objet). Alors qu'en parallèle, la commande CreateObject("Outlook.Application") fonctionne très bien lorsque Outlook est fermé. Pour info, j'ai bien activé Microsoft Outlook 14.0 Object Library.

Pourriez vous m'aider car les paramétrages réseau font que je suis obligé de saisir mon MDP Outlook à chaque ouverture.

Merci d'avance pour votre aide

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
54
55
56
57
58
59
60
Sub Envoi_mail_dd()
' Envoi mail
 
    Dim OutApp As Object
    Dim OutMail As MailItem
    Dim cell As Range
    Dim ChDir As String
    Dim NomFichier As String
    Dim Site As String
    Dim NomPersonne As String
 
 
    Application.ScreenUpdating = False
    Worksheets("Liste de dif").Activate
 
    ChDir = Application.ActiveWorkbook.Path
    Site = "Pusignan"
    NomPersonne = "Suivi des demandes"
    NomFichier = NomPersonne & "_" & Site
 
 
    On Error GoTo Open_Outlook
    Set OutApp = GetObject(, "Outlook.Application")
 
Open_Outlook:
        If Err <> 0 Then
            Set OutApp = CreateObject("Outlook.Application")
            bstarted = True
        End If
 
 
    'On Error GoTo cleanup
    For Each cell In Sheets("Liste de dif").Columns("A").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And Cells(cell.Row, "F").Value = "lyon" Then
            Set OutMail = OutApp.CreateItem(olMailItem)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Suivi des demandes au " & Format(Now, "dd-mmmm-yyyy")
                .Body = "Bonjour " & _
                        vbNewLine & vbNewLine & _
                        "Veuillez trouver en pièce jointe l'état d'avancement du traitement de vos demandes." & _
                        vbNewLine & vbNewLine & _
                        "Vous souhaitant bonne réception," & vbNewLine & _
                        "Cordialement." & vbNewLine & vbNewLine & _
                .Attachments.Add (ChDir & "\Archives suivi Dde" & "\" & NomFichier & "_" & Format(Now, "yy-mm-dd") & ".pdf")
                .Send   'à remplacer par Send / display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell
 
'Envoi mail => cleanup:
    Set OutApp = Nothing
 
    Application.ScreenUpdating = True
    Worksheets("Suivi operation").Activate
 
End Sub