Discussion :

[Desko92]

Bonjour à tous,

J'aurais besoin de votre aide J'ai ma macro ci-dessous pour l'envoi d'un fichier pdf par mail sur Lotus Notes 8.5. La macro fonctionne mais, aléatoirement, j'obtiens le code erreur -2147417851 erreur automation et je n'arrive pas à comprendre pourquoi. En attendant, j'ai mis un On Error GoTo pour pousser l'utilisateur à recliquer sur le bouton. Si vous avez des idées je suis preneur, merci d'avance

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
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
Private Sub CommandButton1_Click()
 
'on crée le fichier PDFdans le même dossier que le fichier source
Sheets("Enquête").ExportAsFixedFormat Type:=xlTypexslm, Filename:= _
ActiveWorkbook.Path & "\" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - DT " & ThisWorkbook.Sheets("Enquête").Range("D3").Value & " - " & ThisWorkbook.Sheets("Enquête").Range("C5").Value & " - Enquête de satisfaction" & ".PDF"
 
lechemin = ActiveWorkbook.Path
lefichier = lechemin & "\" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - DT " & ThisWorkbook.Sheets("Enquête").Range("D3").Value & " - " & ThisWorkbook.Sheets("Enquête").Range("C5").Value & " - Enquête de satisfaction" & ".PDF"
 
Dim MailDb As Object    'The mail database
Dim MailDoc As Object   'The mail document itself
Dim Body As Object
Dim Session As Object   'The notes session
Dim MailDbName As String 'THe current users notes mail database name
Dim ATTACHMENT As String
 
ATTACHMENT = lefichier
 
On Error GoTo errorHandler
 
'Démarrer la session Lotus Notes
Set Session = CreateObject("Notes.NotesSession")
MailDbName = "zzzz" & ".nsf"
'Ouvrir notes
Set MailDb = Session.GetDatabase("", MailDbName)
    If MailDb.IsOpen = True Then 'Lotus déjà ouvert
 
     Else
 
     MailDb.OPENMAIL
 
     End If
 
'Créer le mail
Set MailDoc = MailDb.CreateDocument
Call MailDoc.ReplaceItemValue("Form", "Memo")
 
'Sélectionner destinataire
Call MailDoc.ReplaceItemValue("SendTo", ThisWorkbook.Sheets("Données").Range("A17").Value)
 
'Objet du mail
Call MailDoc.ReplaceItemValue("Subject", ThisWorkbook.Sheets("Enquête").Range("B3").Value & " - DT " & ThisWorkbook.Sheets("Enquête").Range("D3").Value & " - " & ThisWorkbook.Sheets("Enquête").Range("C5").Value & " - Enquête de satisfaction")
 
'Message du mail
Set Body = MailDoc.CreateRichTextItem("Body")
Call Body.AppendText("Veuillez trouver ci-joint l'enquête de satisfaction remplie.")
 
'Attacher la pièce jointe
Call Body.AddNewLine(2)
Call Body.EMBEDOBJECT(1454, "", ATTACHMENT, "Attachment")
 
'Sauvegarder le message
MailDoc.SAVEMESSAGEONSEND = True
 
'Envoi du mail
'Le mail apparaitra dans les courriers envoyés
Call MailDoc.ReplaceItemValue("PostedDate", Now())
 
 
MailDoc.SEND 0, MailDoc.sendto
 
'Nettoyage
Set MailDb = Nothing
Set MailDoc = Nothing
Set Body = Nothing
Set Session = Nothing
 
'la feuille PDF créée est supprimée après l'envoi
Kill ATTACHMENT
'message de confirmation mail envoyé
 
MsgBox "L'enquête de satisfaction a bien été envoyée"
 
Exit Sub
 
errorHandler:
 
MsgBox "Désolé,une erreur s'est produite, merci de bien vouloir recliquer sur le bouton", vbCritical, "Erreur"
 
'Nettoyage
Set MailDb = Nothing
Set MailDoc = Nothing
Set Body = Nothing
Set Session = Nothing
 
'la feuille PDF créée est supprimée après l'envoi
Kill ATTACHMENT
 
 
End Sub

[BENNASR]

bonjour Desko, la forum
voila un code trouvé sur internet que j'utilise pour l'envoie du dossier encours sous format xlsm
en espérant que ça va te donner un coup de main

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
Sub envoiemail()
 Application.ScreenUpdating = False
lefichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
 
   Attachment = lefichier
 
   '************** Application.Dialogs(xlDialogSendMail).Show
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = Session.GETDATABASE("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
         Maildb.OPENMAIL
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.sendto = "a.aaaaa@bbbb.fr"
    MailDoc.Subject = Subject
    MailDoc.Body = BodyText
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    'Set up the embedded object and attachment and attach it
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
    'Send the document
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    MailDoc.SEND 0, Recipient
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
    Application.ScreenUpdating = True
End Sub

[Desko92]

Merci pour ta réponse bennasr, je vais tester