Discussion :

[Ric500]

Bonjour forum !

Je suis en charge d'une application destinée à faire un emailing à partir de données Excel liées dans une base Access. Cet emailing doit se faire à partir de modèles de mails pré-existants.

Dans ma procédure d'envoi en masse, je parcours donc un recordset des contacts sélectionnés par un booléen et crée à chaque itération, un email à partir du modèle sélectionné.
Tout se passe bien (y-compris l'envoi) si je ne gère pas les pièces jointes, par contre, si j'attache des pièces jointes, j'obtiens l'erreur 438: "Propriété ou méthode non gérée par cet objet" lors du Attachements.Add en ligne 47 dans mon code ci-dessous.

Je précise que je soupçonne mon Late-Binding et la "procédure Friend". Ai-je merdé dans sa déclaration?

Mes références déclarées:


Ma procédure d'envoi:

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
61
62
63
64
65
Sub MassSendEmails()
    Dim strSQLContacts As String, rstContacts As Recordset
    Dim leChamp As String, ValChamp As String, NomChamp As String
    Dim strSQLChp As String, rstChamps As Recordset
    Dim appOutlook As Object, intCpt As Long, splitAttached
    Dim oEmail As Object, ModeleLeCorps As String
 
    On Error GoTo ErrMan
 
    'Parcourt les contacts sélectionnés
    strSQLContacts = "SELECT TMP_Contacts.[E-mail] AS [Adresse email], TMP_Contacts.[Agence DSL], TMP_Contacts.[Commercial agence DSL], TMP_Contacts.[Date rendez-vous 1] AS [Date RDV 1], TMP_Contacts.[Date de rendez-vous 2] AS [Date RDV 2], TMP_Contacts.[Email Commercial DSL], TMP_Contacts.NOM, TMP_Contacts.Prénom, TMP_Contacts.[Nom de la société] AS Société, TMP_Contacts.Titre FROM TMP_Contacts WHERE TMP_Contacts.Sel=-1 ;"
    Set rstContacts = CurrentDb.OpenRecordset(strSQLContacts)
 
    'Parcourt les champs
    strSQLChp = "SELECT T_Champs.CHPNom From T_Champs;"
    Set rstChamps = CurrentDb.OpenRecordset(strSQLChp)
 
    'Ouvre le modèle d'eMail
    Set appOutlook = CreateObject("Outlook.Application")
    Set oEmail = appOutlook.CreateItemFromTemplate(Forms!F_ParamEmailing!ModelOFT)
    DoEvents
 
    'Remplace les valeurs et envoi de mail
    With rstContacts
        Do While .EOF = 0
            ModeleLeCorps = oEmail.HTMLBody
            With rstChamps
                rstChamps.MoveFirst
                Do While .EOF = 0
                    leChamp = "<" & !CHPNom & ">"
                    NomChamp = !CHPNom
                    ModeleLeCorps = Replace(ModeleLeCorps, leChamp, Nz(rstContacts("[" & NomChamp & "]"), ""))
                    .MoveNext
                Loop
            End With
            ''''''''''''''''''''''''''''''''''''''''''
            'Envoi de l'email'''''''''''''''''''''''''
            ''''''''''''''''''''''''''''''''''''''''''
            intCpt = 0
            splitAttached = Split(Forms!F_ParamEmailing!Attached, ";")
            With oEmail
                .To = Nz(rstContacts("[" & "Adresse email" & "]"), "")
                .Subject = Forms!F_ParamEmailing!leSujet
                .BodyFormat = 2
                .HTMLBody = ModeleLeCorps
                For intCpt = 0 To UBound(splitAttached)
                    .Attachements.Add "C:\Users\richa\Pictures\MeBlacknWhite.png"    'splitAttached(intCpt)
                Next
                .Send
            End With
            ''''''''''''''''''''''''''''''''''''''''''
            .MoveNext
        Loop
        rstChamps.Close
        rstContacts.Close
    End With
Fin:
    'Libère les ressources
    Set oEmail = Nothing
    Set appOutlook = Nothing
    Exit Sub
ErrMan:
    MsgBox (Error(Err))
    Resume Fin
End Sub

Merci de vos lumières car, là, malgré mes recherches, je n'ai plus trop de billes !

[Ric500]

OK, les gars, y'en a 2 qui suivent... Mais j'ai les noms !!!

Ligne 47 c'était Attachments (et non Attachements...)


Pffff! je suis une quiche !