[Toutes versions] Envoi de plusieurs fichiers [Résolu]

[zoom61]

Salut,

Je ne parviens pas à envoyer plusieurs fichiers cela ne m'envoie que le premier

Voici mon code d'envoi :

Code :

1
2
3
4
5
6
7
8
9
Function essai()
    'Préparation du fichier à envoyé
    txtAttach = CurrentProject.Path & "\Fichier1.xls|" & CurrentProject.Path & "\Fichier2.xls"
 
    'Envoi du fichier à envoyer
    txtSubject = "Sujet"
    txtBody = "Texte"
    Call SendNotesMail((txtSubject), (txtAttach), "", "", "", (txtBody), True, "")
End Function

Et la fonction d'envoi :

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
Public Sub SendNotesMail(ByVal Subject As String, ByVal Attachment As String, _
                         ByVal Recipient As String, ByVal ccRecipient As String, _
                         ByVal bccRecipient As String, ByVal BodyText As String, _
                         ByVal SaveIt As Boolean, ByVal Password As String)
 
    Dim Maildb As Object      'La base des mails
    Dim UserName As String    'Le nom d'utilisateur
    Dim MailDbName As String  'Le nom de la base des mails
    Dim MailDoc As Object     'Le mail
    Dim AttachME As Object    'L'objet pièce jointe en RTF
    Dim Session As Object     'La session Notes
    Dim EmbedObj As Object    'L'objet incorporé
 
    Dim recip() As Variant
 
    'Crée une session notes
    Set Session = CreateObject("Notes.NotesSession")
 
    '*** Cette ligne est réservée aux versions 5.x et supérieur : ***
    'Session.Initialize (Password)
 
    'Récupère le nom d'utilisateur et crée le nom de la base des mails
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
 
    'Ouvre la base des mails
    Set Maildb = Session.GETDATABASE("", MailDbName)
    If Not Maildb.ISOPEN Then Maildb.OPENMAIL
 
    'Redimensionne le tableau
    CptSQL = "SELECT Count(T_DIFFUSION_MAIL.MAIL) AS NB FROM T_DIFFUSION_MAIL;"
    Set OCptSQL = CurrentDb.OpenRecordset(CptSQL)
    nb = OCptSQL.Fields(0)
    Set OCptSQL = Nothing
    ReDim recip(nb)
 
    'Crée la liste d'envoi
    LstSQL = "SELECT MAIL FROM T_DIFFUSION_MAIL"
    Set OLstSQL = CurrentDb.OpenRecordset(LstSQL)
    i = 0
    While Not OLstSQL.EOF
        recip(i) = OLstSQL.Fields(0)
        i = i + 1
        OLstSQL.MoveNext
    Wend
    OLstSQL.Close
    Set OLstSQL = Nothing
 
    'Paramètre le mail à envoyer
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.SendTo = recip
    MailDoc.CopyTo = ccRecipient
    MailDoc.BlindCopyTo = bccRecipient
    MailDoc.Subject = Subject
    MailDoc.Body = BodyText
    MailDoc.SAVEMESSAGEONSEND = SaveIt
 
    'Prend en compte les pièces jointes
    Dim varObjPJ As Variant
    varObjPJ = Split(Attachment, "|")
 
    '   If Not IsMissing(Attachment) Then
    If Attachment <> "" Then
          For i = UBound(varObjPJ) - 1 To 0 Step -1
            Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment" & i)
            Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", varObjPJ(i), "Attachment" & i)
            MailDoc.CREATERICHTEXTITEM ("myfiles" & i)
          Next i
    End If
 
    'Envoie le mail
    MailDoc.PostedDate = Now()
    MailDoc.Send 0, Recipient
 
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub

Avez-vous une idée sur l'erreur que j'ai fait

@+.

[zoom61]

J'ai trouvé un début de réponse, il ne prend pas le dernier fichier, donc si je fais :

Code :

1
2
3
4
5
6
7
8
9
Function essai()
    'Préparation du fichier à envoyé
    txtAttach = CurrentProject.Path & "\Fichier1.xls|" & CurrentProject.Path & "\Fichier2.xls|" & CurrentProject.Path & "\Fichier2.xls"
 
    'Envoi du fichier à envoyer
    txtSubject = "Sujet"
    txtBody = "Texte"
    Call SendNotesMail((txtSubject), (txtAttach), "", "", "", (txtBody), True, "")
End Function

J'obtiens bien les fichiers 1 et 2 dans mon mail

[fevec]

Bonjour,

Sauf erreur de ma part
Ligne 65 : dans la function SendNotesMail

Code :

      For i = UBound(varObjPJ) To 0 Step -1

à la place de

Code :

      For i = UBound(varObjPJ) - 1 To 0 Step -1

non ?
J'ai noté la discussion qui m'a permis d'avancer sur l'envoi de plusieurs pièce jointes avec la funtion CDOSendMail

cordialement,
fevec