[XL-2010] Macro Publimailing Lotus Notes

Macro Publimailing Lotus Notes

Bonjour,

Tout d'abord merci pour ce site formidable qui est une véritable source d'inspiration pour la non développeur pro que je suis...:ccool:

Voilou mon pitit problème:
J'ai codé une macro pour publiposter des mails sous Lotus Notes mais de temps en temps la macro bug et m'affiche le message "Objet Requis":cry:. J'ai beau relire mon code je ne vois pas l'erreur qui est à mon avis une mauvaise déclaration...
Alors si une personne plus experte que moi peux y jeter un coup d'oeil ça serait top sympa.

Merci d'avance.

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Public Sub RelanceMail_SF_SP()
 
'On Error Resume Next
 
Dim Session As Object
Dim db As Object
Dim doc As Object
Dim EmbedObj As Object
Dim Compte As Integer
Dim MaFeuill3 As String
Dim MonMail As String
Dim Verif3 As Integer
 
'Nom de l'onglet
MaFeuille3 = "Mail"
 
Verif3 = 0
 
'Numéro de Colonnes
FirstLigne = 6
ColDebRel = 23
ColFinRel = 24
ColSucces = 25
ColMail = 30
 
For Each Ws In Worksheets
    If Ws.Name = MaFeuille3 Then
        Verif3 = 1
        Exit For
    End If
Next Ws
 
If Verif3 < 1 Then
    MsgBox "Vous n'avez pas copier/coller l'onglet 'Mail'" & vbCrLf & "Arrêt de la Macro", vbInformation, "ERREUR"
    Exit Sub
End If
 
If Sheets(MaFeuille3).Cells(34, 3).Value = "Absente" And Sheets(MaFeuille3).Cells(34, 6).Value = "Absente" Then
    MsgBox "Il faut au moins une personne au statut 'Présente' dans l'onglet 'Mail'" & vbCrLf & "Arrêt de la Macro", vbInformation, "ERREUR"
    Exit Sub
End If
 
'Dernière ligne du tableau de Synthèse
LastLigne = Feuil2.Cells(65536, 7).End(xlUp).Row '<<<<<<<<<<<<<<<<<<<<<  Feuil2 = SF_SP et Feuil3 = SNF_IND
 
'Ouverture d'une session Notes
Set Session = CreateObject("notes.notessession")
Set db = Session.GetDatabase("", "")
Call db.OPENMAIL
 
'Plage Colonne Début Date de Relance
Set plage = Feuil2.Range(Feuil2.Cells(6, ColDebRel), Feuil2.Cells(LastLigne, ColDebRel)) '<<<<<<<<<<<<<<<<<<<<<
 
Compte = 0
For Each Cellule In plage
    If Cellule.Offset(0, 2) = 1 And Cellule.Offset(0, 1) >= Date Then
        Cellule.Offset(0, 1).Value = "Stop le " & Date
    End If
 
    If Cellule <= Date And Cellule.Offset(0, 1) >= Date And Cellule.Offset(0, 2) <> 1 And Cellule.Offset(0, 7) <> "" Then
 
        Set doc = db.CreateDocument
 
        MailDestinataire = Cellule.Offset(0, 7)
        MailCopie = Cellule.Offset(0, 8)
        Sujet = "[" & Cellule.Offset(0, -16) & "]" & " " & Sheets(MaFeuille3).Cells(8, 6)
        If Sheets(MaFeuille3).Cells(34, 3).Value = "Présente" Then '<<<<<<<<<<<<<<<<<<<<<
            CorpsMessage = Sheets(MaFeuille3).Cells(10, 3) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(12, 3) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(14, 3) & " " & Cellule.Offset(0, -15) & " " & Cellule.Offset(0, -12) & " " & Sheets(MaFeuille3).Cells(15, 3) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(17, 3) & vbCrLf & _
                        Sheets(MaFeuille3).Cells(18, 3) & " " & Cellule.Offset(0, -7) & "€" & vbCrLf & _
                        Sheets(MaFeuille3).Cells(19, 3) & " " & Cellule.Offset(0, -8) & "€" & vbCrLf & _
                        Sheets(MaFeuille3).Cells(20, 3) & " " & Cellule.Offset(0, -9) & "€" & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(22, 3) & vbCrLf & _
                        Cellule.Offset(0, -4) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(24, 3) & vbCrLf & _
                        Cellule.Offset(0, -5) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(27, 3) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(29, 3) & vbCrLf & Sheets(MaFeuille3).Cells(30, 3) & vbCrLf & Sheets(MaFeuille3).Cells(31, 3) '<<<<<<<<<<<<<<<<<<<<<
            MonMail = Sheets(MaFeuille3).Cells(32, 3).Value '<<<<<<<<<<<<<<<<<<<<<
        ElseIf Sheets(MaFeuille3).Cells(34, 3).Value = "Absente" Then '<<<<<<<<<<<<<<<<<<<<<
            CorpsMessage = Sheets(MaFeuille3).Cells(10, 3) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(12, 3) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(14, 3) & " " & Cellule.Offset(0, -15) & " " & Cellule.Offset(0, -12) & " " & Sheets(MaFeuille3).Cells(15, 3) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(17, 3) & vbCrLf & _
                        Sheets(MaFeuille3).Cells(18, 3) & " " & Cellule.Offset(0, -7) & "€" & vbCrLf & _
                        Sheets(MaFeuille3).Cells(19, 3) & " " & Cellule.Offset(0, -8) & "€" & vbCrLf & _
                        Sheets(MaFeuille3).Cells(20, 3) & " " & Cellule.Offset(0, -9) & "€" & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(22, 3) & vbCrLf & _
                        Cellule.Offset(0, -4) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(24, 3) & vbCrLf & _
                        Cellule.Offset(0, -5) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(27, 6) & vbCrLf & vbCrLf & _
                        Sheets(MaFeuille3).Cells(29, 6) & vbCrLf & Sheets(MaFeuille3).Cells(30, 6) & vbCrLf & Sheets(MaFeuille3).Cells(31, 6) '<<<<<<<<<<<<<<<<<<<<<
            MonMail = Sheets(MaFeuille3).Cells(32, 6).Value '<<<<<<<<<<<<<<<<<<<<<
        End If
 
        With doc
            .Form = "Memo"
            .sendto = MailDestinataire
            .copyto = MailCopie
            .Subject = Sujet
            .Body = CorpsMessage
            .Replyto = MonMail
            .SaveMessageOnSend = True
            .PostedDate = Now
            .SenderTag = "M"
            .deliverypriority = "H"
            .Importance = "1"
        End With
 
        Call doc.Send(False)
        Compte = Compte + 1
        Application.StatusBar = Compte & " Mails envoyés"
    End If
Next Cellule
 
Set plage = Nothing
Set Session = Nothing
Set db = Nothing
Set doc = Nothing
 
Application.StatusBar = False
 
MsgBox "PubliMailing Terminé" & vbCrLf & Compte & " Mails envoyés", vbInformation, "RELANCES AUTO"
 
End Sub

Bonjour

sur qu'elle ligne l'erreur ?

Bonjour,

Un exemple utilisé depuis plusieurs années :

Code:

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
Sub EnvoyerUnMailNotes(ObjetDuMail As String, MessageDuMail As String, AdresseMail As String)
 
' Par un auteur inconnu du MPFE - Peut-être Frédéric SIGONNEAU
 
Dim ObjNotesSession As Object
Dim ObjNotesMailFile As Object
Dim ObjNotesDocument As Object
Dim ObjNotesField As Object
Dim SendMail As Boolean
 
Dim Msg As String
 
Dim EMailCCTo As String
Dim EMailBCCTo As String
 
        On Error GoTo SendMailError
        EMailCCTo = "" '' Optional
        EMailBCCTo = "" '' Optional
 
        Set ObjNotesSession = CreateObject("Notes.NotesSession")    ' Etablissement de la connection à Notes
        Set ObjNotesMailFile = ObjNotesSession.GETDATABASE("", "")  ' Establish Connection to Mail File  '' .GETDATABASE("SERVER", "FILE")
 
        ObjNotesMailFile.OPENMAIL 'Ouverture du Mail
 
        Set ObjNotesDocument = ObjNotesMailFile.CREATEDOCUMENT                          ' Création d'un nouveau mémo
        Set ObjNotesField = ObjNotesDocument.APPENDITEMVALUE("Subject", ObjetDuMail)    ' Create 'Subject Field'
        Set ObjNotesField = ObjNotesDocument.APPENDITEMVALUE("SendTo", AdresseMail)     ' Create 'Send To' Field
        Set ObjNotesField = ObjNotesDocument.APPENDITEMVALUE("CopyTo", EMailCCTo)       ' Adresser en copie
        Set ObjNotesField = ObjNotesDocument.APPENDITEMVALUE("BlindCopyTo", EMailBCCTo) ' Adresser en copie cachée
        Set ObjNotesField = ObjNotesDocument.CREATERICHTEXTITEM("Body") ' Corps du message
 
        ObjNotesField.APPENDTEXT MessageDuMail
        'ObjNotesField = ObjNotesField.EMBEDOBJECT(1454, "", ActiveWorkbook.FullName) ' Attacher le fichier --1454 indique un attachement de fichier
        ObjNotesDocument.SEND (0) ' Envoi du mail
 
    ''Release storage
    Set ObjNotesSession = Nothing
    Set ObjNotesMailFile = Nothing
    Set ObjNotesDocument = Nothing
    Set ObjNotesField = Nothing
 
    ''Set return code
    SendMail = True
    Exit Sub
 
SendMailError:
    Msg = "Error # " & Str(Err.Number) & " was generated by " _
    & Err.Source & Chr(13) & Err.Description
    MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
    SendMail = False
 
End Sub

Cordialement.

Merci

Je vais regarder ça merci.

bbil > Aucune ligne en erreur juste un message d'erreur d'où mon gros problème pour débuguer. Et bizarrement ça ne plante pas quand VBE est ouvert.