Discussion :

[olivepao]

Bonjour tout le monde

Je rencontre un petit problème pour l'envoi multiutilisateurs de fichiers (plusieurs) avec Excel.

Premièrement, je suis sous Windows 10 et Office 365.

J'arrive, dans un premier temps, avec ma macro (Module 2) à ouvrir l'explorateur afin de sélectionner les fichiers que je désire mettre en pièces jointes.
J'arrive également à sélectionner les adresses mail figurant sur la feuille.

Lorsque je valide, le courriel s'affiche avec les destinataires mais les pièces jointes ne sont pas jointes.

J'ai effectué de nombreuses recherches mais je sèche depuis quelques jours afin de trouver une solution.

Je vous remercie, par avance de votre précieuse aide.

Je joints le code et le fichier.

PS : Prenez votre temps, car avec mes horaires de ouf, je ne pense pas pouvoir revenir d'ici le week-end prochain.

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
 
Sub Envoidoc()
' Envoi courriel multidestinataires avec documents
Dim OTApp As Object
Dim MItem  As Object
Dim Cellules As Range
Dim Lignes As Range
Dim Adr_Courriel As String
Dim Txt_Texte As String
Dim Nbre_Fichier As Variant
ChDir "C:\"
 
On Error Resume Next
 
' Fichiers à joindre
Nbre_Fichier = Application.GetOpenFilename( _
    Title:="                                                SÉLECTIONNEZ  LE(S) FICHIER(S) Á JOINDRE AU COURRIEL ", _
    FileFilter:="Extention de fichier,*.*", _
    MultiSelect:=True)
 
' Nbre de fichiers joints
If Not IsArray(Nbre_Fichier) Then
    MsgBox "AUCUN FICHIER SÉLECTIONNÉ !"
Else
    MsgBox UBound(Nbre_Fichier) - LBound(Nbre_Fichier) + 1 _
    & " FICHIER(S) SÉLECTIONNÉ(S) !"
End If
 
On Error Resume Next
      Txt_Texte = "Choisissez vos adresses courriel"
' Sélection des adresses courriel
Set Lignes = Application.InputBox( _
    Title:="        SAISIE DES ADRESSES COURRIEL", _
    Prompt:=" UTILISEZ LE CLIC GAUCHE DE LA SOURIS ET LA TOUCHE CTRL DU CLAVIER ENFONCÉE ! ", _
    Default:=Txt_Texte, _
    Left:=500, _
    Top:=500, _
    Type:=8)
 
    If Lignes Is Nothing Then Exit Sub
    Set OTApp = CreateObject("Outlook.Application")
    For Each Cellules In Lignes
 
If Cellules.Value Like "*@*" Then
 
    If Adr_Courriel = "" Then
        Adr_Courriel = Cellules.Value
            Else
                Adr_Courriel = Adr_Courriel & ";" & Cellules.Value
    End If
 
End If
 
    Next
 
Set MItem = OTApp.CreateItem(0)
' Remplissage du courriel
With MItem
        .To = Adr_Courriel
        .Display
        .Attachments.Add Nbre_Fichier
 
End With
 
End Sub

[EJO64]

Bonjour,

Je pense qu'une simple boucle sur le tableau Nbre_fichier fait l'affaire

dans cette partie

Code :

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

1
2
3
4
5
6
 With MItem
        .To = Adr_Courriel
        .Display
        .Attachments.Add Nbre_Fichier
 
End With

ajouter un boucle sur le tableau

Code :

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

1
2
3
4
5
6
7
8
With MItem
        .to = Adr_Courriel
        .Display
        For i = 1 To UBound(Nbre_Fichier)
        .Attachments.Add Nbre_Fichier(i)
        Next
 
End With

[olivepao]

Bonjour EJO64, bonjour tout le monde

Je viens de tester ta proposition.

Malheureusement, les fichiers ne sont toujours pas mis en pièces jointe.

J'ai essayé aussi de trouver d'autres solutions sur le net mais toujours sans succès.

Si d'autres personnes ont une ou des idées, je suis toujours preneur.

Meilleurs messages à tous.

Olivier

[patricktoulon]

bonjour
je ne sais pas avec outlook mais avec cdo on peut intégré en piece jointe x fichiers sans boucle

Code :

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

1
2
3
4
5
6
With MItem
        .To = Adr_Courriel
        .Display
        .Attachments.Add Join(Nbre_Fichier, ";")'pour le separateur je ne sais pas non plus avec outlook,avec cdo c'est ";"
 
End With

[olivepao]

Hello Patrick

Merci pour ta réponse mais ta proposition n'a pas d'effet.

Bonne fin de journée

[olivepao]

Hello le forum

Petite précision à ma demande.

Avec le code ci-dessous, l'envoi d'UN SEUL fichier s'effectue !

J'ai essayer de l'adapter pour un envoi multi-fichiers mais . . .

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
 
Sub Envoidoc()
' Envoi courriel multidestinataires avec document
    Dim OTApp As Object
    Dim MItem As Object
    Dim Cellules As Range
    Dim Lignes As Range
    Dim Adr_Courriel  As String
    Dim Txt_Texte As String
    Dim Nbre_Fichier  As String
 
Nbre_Fichier  = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
  If Nbre_Fichier  = "" Then
    MsgBox "Aucun fichier sélectionné"
    Exit Sub
  End If
 
On Error Resume Next
    Txt_Texte = "Choisissez vos adresses courriel"
 
    Set Lignes = Application.InputBox( _
      Title:="        SAISIE DES ADRESSES COURRIEL", _
      Prompt:=" UTILISEZ LE CLIC GAUCHE DE LA SOURIS ET LA TOUCHE CTRL DU CLAVIER ENFONCÉE ! ", _
      Default:=Txt_Texte, _
      Left:=500, _
      Top:=500, _
      Type:=8)
 
    If Lignes Is Nothing Then Exit Sub
    Set OTApp = CreateObject("Outlook.Application")
    For Each Cellules In Lignes
        If Cellules.Value Like "*@*" Then
            If Adr_Courriel  = "" Then
                Adr_Courriel  = Cellules.Value
            Else
                Adr_Courriel  = Adr_Courriel  & ";" & Cellules.Value
            End If
        End If
Next
    Set MItem  = OTApp.CreateItem(0)
With MItem 
        .To = Adr_Courriel 
        .Display
        .Attachments.Add Nbre_Fichier 
End With
End Sub