Discussion :

[ingenieurdu94]

Bonjour a tous,

Je sollicite votre aide car j'ai un souci sur une de mes macros. En effet, j'ai une macro qui me permet de: creer un email ( avec IBM Lotus )et joindre un fichier pdf avec. J'aimerai cependant joindre plusieurs fichiers dans ce mail et pas qu'un seul. D'ailleurs le nombre n'est pas fixe il changera a chaque fois.

Voici mon code pour joindre un seul fichier a mon email:

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 Button2_Click()
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim envoyerA As String, envoyerCc As String, Subject As String, Body As String
Dim file_name As String
 
envoyerA = Sheets("Sheet1").Range("mailto").Value
Subject = Sheets("Sheet1").Range("Subject").Value
Body = Sheets("Sheet1").Range("Body").Value
 
file_name=Derso\test.pdf
 
Dim objNotes As Object, objNotesDB As Object, objNotesMailDoc As Object
Dim SendItem, NCopyItem, BlindCopyToItem, i As Integer, rtitem
Dim Msg As String
On Error Resume Next
AppActivate "Notes"
 
 
If Not Err.Number = 0 Then
Err.Clear
 
Else
Set objNotes = GetObject("", "Notes.Notessession")
Set objNotesDB = objNotes.GETDATABASE("", "")
Call objNotesDB.OPENMAIL
Set objNotesMailDoc = objNotesDB.CREATEDOCUMENT
objNotesMailDoc.Form = "Memo"
 
 
 
Call objNotesMailDoc.Save(True, False)
Set SendItem = objNotesMailDoc.APPENDITEMVALUE("SendTo", "")
Set NCopyItem = objNotesMailDoc.APPENDITEMVALUE("CopyTo", "")
Set BlindCopyToItem = objNotesMailDoc.APPENDITEMVALUE("BlindCopyTo", "")
objNotesMailDoc.SendTo = envoyerA
objNotesMailDoc.Subject = Subject
Set rtitem = objNotesMailDoc.CREATERICHTEXTITEM("Body")
objNotesMailDoc.Body = Body
 
''''''''''''''''''''''''''''''''''''''''attachment
Dim EmbedObj As Object
Set EmbedObj = rtitem.EmbedObject(1454, "Body", file_name, "")
''''''''''''''''''''''''''''''''''''''''
 
rtitem.ADDNEWLINE (1)
Call objNotesMailDoc.Save(True, False)
objNotesMailDoc.RemoveItem ("DeliveredDate")
Call objNotesMailDoc.Save(True, False)
AppActivate ("Microsoft Excel")
Msg = "Mail cree"
MsgBox Msg, vbInformation, "Notesmail Draft..."
Call objNotes.Close
Set objNotes = Nothing
Exit Sub
End If
 
End Sub

Ce que j'ai essaye de changer: J'ai cree une liste Table qui contient le nom (A et B par exemple) des fichiers a joindre

Dans la partie "attachement"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim EmbedObj As Object
For p = 2 To UBound(Table)
Nom = Table(p)
file_name = "Derso\" & Nom & ".pdf"
Set EmbedObj = rtitem.EmbedObject(1454, "Body", file_name, "")
Next p

Mais malheureusement cela fait planter Lotus et je ne pense pas que ce soit la bonne methode.

En vous remerciant par avance de votre aide

[dadavyvy]

Bonjour,

Je ne sais pas ce qu'il y a dans la variable Table (qu'il faut d'ailleurs éviter de nommer 'Table') et pourquoi l'indice commence à 2.

Pour ajouter 2 PJ, il suffit de faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Call rtitem.EmbedObject(1454, "", file_name1)
Call rtitem.EmbedObject(1454, "", file_name2)

Ensuite si cela plante Lotus Notes, il faut faire du 'pas à pas' pour savoir quelle ligne cause le plantage.

Cdlt

[Fpizzi]

Bonjour,

Désolé si j'up un vieux topic.

Grâce à ce sujet j'ai pu créer un mail avec pièce jointe qui se met dans les drafts ... hors j'aimerais que ce dernier soit envoyé directement ...

Le fichier est un .pdf générer depuis excel.

Mais je bloque ...

Voici le code

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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Sub senmail()
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim envoyerA As String, envoyerCc As String, Subject As String, Body As String
Dim file_name As String
Dim date_commande As Date
 
date_commande = Date + 1
'-----------------------------------------------------------------------------------------------------------------------------
'Création du fichier PDF
    Dim sRep As String                  ' Répertoire de sauvegarde
    Dim sFilename As String             ' Nom du fichier
    Dim today As String
    Dim path As String
     sRep = "V:\"                       ' Répertoire de sauvegarde (si non spécifié, répertoire actif par défaut)
     sFilename = "Commande carton" & "-" & ActiveSheet.Name & "-" & Range("B1").Value & "." & "pdf"      ' Nom du fichier
 
    path = sRep & "Commande carton" & "-" & ActiveSheet.Name & "-" & Range("B1").Value & "." & "pdf"
    Range("M1").Value = path
 
    Range("A1:H38").Select
    Selection.ExportAsFixedFormat _
                     Type:=xlTypePDF, _
                     Filename:=sRep & sFilename, _
                     Quality:=xlQualityStandard, _
                     IncludeDocProperties:=True, _
                     IgnorePrintAreas:=False, _
                     OpenAfterPublish:=False
'---------------------------------------------------------------------------------------------------------------------------------
envoyerA = "xxxx@yyyy.com" 'ancienne valeur Sheets("Sheet1").Range("mailto").Value
Subject = "Commande Carton" 'Sheets("Sheet1").Range("Subject").Value
Body = "Bonjour VVV," & vbLf & vbLf & "Voici notre commande en pièce jointe:"
 
file_name = path 'fichier en piece jointe
 
Dim objNotes As Object, objNotesDB As Object, objNotesMailDoc As Object
Dim SendItem, NCopyItem, BlindCopyToItem, i As Integer, rtitem
Dim Msg As String
On Error Resume Next
AppActivate "Notes"
 
 
If Not Err.Number = 0 Then
Err.Clear
 
Else
Set objNotes = GetObject("", "Notes.Notessession")
Set objNotesDB = objNotes.GETDATABASE("", "")
Call objNotesDB.OPENMAIL
Set objNotesMailDoc = objNotesDB.CREATEDOCUMENT
objNotesMailDoc.Form = "Memo"
 
 
 
Call objNotesMailDoc.Save(True, False)
Set SendItem = objNotesMailDoc.APPENDITEMVALUE("SendTo", "")
Set NCopyItem = objNotesMailDoc.APPENDITEMVALUE("CopyTo", "")
Set BlindCopyToItem = objNotesMailDoc.APPENDITEMVALUE("BlindCopyTo", "")
objNotesMailDoc.SendTo = envoyerA
objNotesMailDoc.Subject = Subject
Set rtitem = objNotesMailDoc.CREATERICHTEXTITEM("Body")
objNotesMailDoc.Body = Body
 
''''''''''''''''''''''''''''''''''''''''attachment
Dim EmbedObj As Object
Set EmbedObj = rtitem.EmbedObject(1454, "Body", file_name, "")
''''''''''''''''''''''''''''''''''''''''
 
rtitem.ADDNEWLINE (1)
Call objNotesMailDoc.Save(True, False)
'objNotesMailDoc.RemoveItem ("DeliveredDate")
Call objNotesMailDoc.Save(True, False)
 
'---
MailDoc.PostedDate = Now()
MailDoc.Send 0, "xxxxx@xxx.com"
'---
AppActivate ("Microsoft Excel")
Msg = "Mail cree"
MsgBox Msg, vbInformation, "Notesmail Draft..."
 
 
 
Call objNotes.Close
Set objNotes = Nothing
 
Call clearvalue
 
Exit Sub
End If
Call Doc.Send(True)
End Sub
 
' Efface les valeurs dans le tableau
Function clearvalue() 
' clearvalue Macro
 
    Range("A6:F6,F8:F15,D21:E33").Select
    Range("D21").Activate
    Selection.ClearContents
    Range("A2").Select
End Function