Discussion :

[Domdrum]

Bonsoir à toutes et tous,

Je souhaite envoyer, depuis un formulaire, un mail avec en pièces jointes tous les fichiers contenus dans un répertoire. Il m'est impossible de nommer individuellement chaque fichier vu que le contenu du répertoire varie d'un envoi à l'autre. Par contre, c'est bien à chaque fois tout le contenu du répertoire qu'il faut joindre au mail.
J'ai trouvé le code suivant sur le site, qui fonctionne parfaitement :

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
Public Sub CreateEmail( _
    Recipient As String, _
    Subject As String, _
    Body As String, _
    Optional Attach As Variant)
 ' --------------------------
    Dim I As Integer
    Dim oEmail As Outlook.MailItem
    Dim appOutLook As Outlook.Application
    ' créer un nouvel item mail
    Set appOutLook = New Outlook.Application
    Set oEmail = appOutLook.CreateItem(olMailItem)
    ' les paramètres
    oEmail.To = Recipient
    oEmail.Subject = Subject
    oEmail.Body = Body
    If Not IsMissing(Attach) Then
       If TypeName(Attach) = "String" Then
             ' s'il y a des pièces jointes
            oEmail.Attachments.Add Attach
        Else
            For I = 0 To UBound(Attach) - 1
            oEmail.Attachments.Add Attach(I)
            Next
        End If
    End If
    ' envoie le message
    oEmail.Send
    ' détruit les références aux objets
    Set oEmail = Nothing
    Set appOutLook = Nothing
 
End Sub

Je l'appelle avec le code suivant :

Code :

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

Call CreateEmail("CMI", "CMI - Transmission de fiches", "Voir fichiers ci-annexés", "c:\cmi\envoi\*.*")

Et là ça coince à cause de mon adresse "c:\cmi\envoi\*.*"
Erreur d'exécution '-1966071 (ffe20009)':
Seulement des fichiers ou des objets peuvent être utilisés comme pièces jointes.
c:\cmi\envoi\*.* est un dossier, il ne peut donc pas être joint

Quelqu'un peut-il me donner une piste ? Merci !

[Pierre Fauconnier]

Bonsoir

Tu dois attacher chaque fichier en pièce jointe, et donc itérer sur les fichiers du dossier et ajouter la chaine de caractères de chaque fichier

Code :

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

1
2
3
4
5
6
    Fichier = Dir(Attach)
    Attach = Replace(Attach, "*.*", "")
    Do While Fichier <> ""
        oMail.Attachments.Add Attach & Fichier
        Fichier = Dir()
    Loop

Idéalement, il faut s'assurer qu'il n'y a que des fichiers dans le dossier, et ne pas oublier Dim Fichier as string en début de procédure.

Question HS: CMI Seraing?

[Domdrum]

Merci, Pierre.

J'ai adapté le code comme suit, mais je ne parviens toujours pas à joindre les fichiers contenus dans le répertoire "Envoi"

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
Public Sub CreateEmail( _
    Recipient As String, _
    Subject As String, _
    Body As String, _
    Optional Attach As Variant)
 ' --------------------------
    Dim I As Integer
    Dim oEmail As Outlook.MailItem
    Dim appOutLook As Outlook.Application
    Dim Fichier As String
 
    ' créer un nouvel item mail
 
    Set appOutLook = New Outlook.Application
    Set oEmail = appOutLook.CreateItem(olMailItem)
 
    ' les paramètres
 
    oEmail.To = Recipient
    oEmail.Subject = Subject
    oEmail.Body = Body
 
    If Not IsMissing(Attach) Then
 
       If TypeName(Attach) = "String" Then
 
Fichier = Dir(Attach)
Attach = Replace(Attach, "*.*", "")
Do While Fichier <> ""
    oMail.Attachments.Add Attach & Fichier
    Fichier = Dir()
Loop
 
 
 
        Else
 
            For I = 0 To UBound(Attach) - 1
            oEmail.Attachments.Add Attach(I)
 
            Next
 
        End If
 
    End If
 
    ' envoie le message
    oEmail.Send
 
    ' détruit les références aux objets
    Set oEmail = Nothing
 
    Set appOutLook = Nothing
 
End Sub

Code :

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

1
2
3
4
5
Private Sub Mail_Click()
 
Call CreateEmail("CMI", "CMI - Transmission de fiches", "Voir fichiers ci-annexés", "c:\cmi\envoi")
 
End Sub

[Pierre Fauconnier]

C'est parce que tu as changé la valeur de ATTACH

Dans ton premier exemple, tu passais "c:\cmi\envoi\*.*"
Dans le deuxième, tu passes "c:\cmi\envoi"
Si tu tiens à garder le deuxième, tu dois adapter le code

Code :

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

1
2
3
4
5
6
 
...
Fichier = Dir(Attach & "\*.*")
attach = attach & "\"
Do While Fichier <> ""
...

Car tu dois adapter la valeur de Attach pour Dir (qui demande *.*) puis après, tu dois l'utiliser avec le nom renvoyé par Dir pour composer le chemin complet de chaque fichier à attacher.

[Domdrum]

Impecc !

Merci Pierre !

Voici le code final qui fonctionne parfaitement :

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
Public Sub CreateEmail( _
    Recipient As String, _
    Subject As String, _
    Body As String, _
    Optional Attach As Variant)
 ' --------------------------
    Dim I As Integer
    Dim oEmail As Outlook.MailItem
    Dim appOutLook As Outlook.Application
    Dim Fichier As String
 
    ' créer un nouvel item mail
 
    Set appOutLook = New Outlook.Application
    Set oEmail = appOutLook.CreateItem(olMailItem)
 
    ' les paramètres
 
    oEmail.To = Recipient
    oEmail.Subject = Subject
    oEmail.Body = Body
 
    If Not IsMissing(Attach) Then
 
    If TypeName(Attach) = "String" Then
 
    Fichier = Dir(Attach & "\*.*")
    Attach = Attach & "\"
    Do While Fichier <> ""
 
    oEmail.Attachments.Add Attach & Fichier
 
    Fichier = Dir()
    Loop
 
    Else
 
        For I = 0 To UBound(Attach) - 1
        oEmail.Attachments.Add Attach(I)
 
        Next
 
        End If
 
    End If
 
    ' envoie le message
    oEmail.Send
 
    ' détruit les références aux objets
    Set oEmail = Nothing
 
    Set appOutLook = Nothing
 
End Sub

Appel de la commande par le code :

Code :

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

1
2
3
4
5
Private Sub Mail_Click()
 
Call CreateEmail("CMI", "CMI - Transmission de fiches", "Voir fichiers ci-annexés", "c:\cmi\envoi")
 
End Sub

Bonne soirée