[Toutes versions] Macro VBA pour joindre plusieurs fichiers dans email

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:

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=D:Perso\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:

1
2
3
4
5
6
Dim EmbedObj As Object
         For p = 2 To UBound(Table)
         Nom = Table(p)
         file_name = "D:Perso\" & 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