[XL-365] Envoi mail avec attachment

Envoi mail avec attachment

Bonjour la Communauté,

Je voudrais envoyer un mail via excel avec comme attachment (en C:\XXXX\A.pdf) un fichier correspondant à la valeur se trouvant en colonne A de ma feuille excel.

Dans ce cas-ci j'ai essayé

Code:

.Attachments.Add "C:\xxx\" & Range("A" & cROw) & ".pdf"

En somme je parviens pas à récupérer la valeur réelle de A de ma feuille excel.

Merci d'avance

Habiler

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
82
83
84
85
86
 Option Explicit
 
Dim titleName As String
Dim firstName As String
Dim lastName As String
Dim fullName As String
Dim clientEmail As String
Dim ccEmail As String
Dim bccEmail As String
Dim emailMessage As String
 Dim cROw As Long
 
Sub GenerateInfo()
 
    Dim WS As Worksheet
    Dim lrow As Long
    Dim cROw As Long
 
    Set WS = ActiveSheet
 
    With WS
        lrow = .Range("A" & .Rows.Count).End(xlUp).Row
        Application.ScreenUpdating = False
        For cROw = 2 To lrow
            If Not .Range("A" & cROw).Value = "" Then
 
                firstName = .Range("C" & cROw).Value
                clientEmail = .Range("E" & cROw).Value
 
                Call SendEmail(cROw)
 
                .Range("Y" & cROw).Value = "Yes"
                .Range("Y" & cROw).Font.Color = vbGreen
 
            Else
                .Range("Y" & cROw).Value = "No"
                .Range("Y" & cROw).Font.Color = vbRed
            End If
        Next cROw
    End With
 
    Application.ScreenUpdating = True
 
    MsgBox "Process completed!", vbInformation
 
End Sub
Sub SendEmail(cROw As Long)
 
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim sigString As String
    Dim Signature As String
    Dim insertPhoto As String
    Dim photoSize As String
 
    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)
 
 
    emailMessage = " Hello " & _
                    "<p>  <strong> xxxxxxxxx </strong>." & _
                    "<p>." & _
                    "<p>E" & _
                    "<p>"
 
 
    With outlookMail
        '.To = clientEmail
        .To = "moi@moi.com"
        .CC = ""
        .BCC = ""
        .Subject = "xxxxxxxxxxxxxxxxxxx"
        .BodyFormat = 2
        .Attachments.Add "C:\xxx\" & Range("A" & cROw) & ".pdf"
        Debug.Print cROw
        .HTMLBody = emailMessage
        .Importance = 2
        '.ReadReceiptRequested = True
        .Display
        '.Send
 
    End With
 
    Set outlookApp = Nothing
    Set outlookMail = Nothing
End Sub

Bonjour à tous,

à quoi correspond ta variable cROw ?

pour savoir le résultat, tu peux faire un msgbox

Code:

msgbox Range("A" & cROw)

mais je pense qu'il n'y aura pas de résultats

Bonsoir,

cRow le numéro de rangée.
Pour avancer de une rangée jusqu'à ce que la rangée soit Vide. Et le contenu de A est une clé pour rechercher le document dans la directory.
C'est un code trouvé sur internet et adapté car c'est assez urgent et je m'emmeèle les pinceaux (mais de gros pinceaux.)

Merci d'avance

Habiler

"A" est la colonne,
donc cROw doit être la ligne ?

Excel ne sait pas de quelle ligne il s'agit

Bonjour à tous,

En fait ce que je cherche à faire c'est de trouver la valeur de A1 par ex. dans le répertoire C:\XXXX

Pas facile à trouver et mes connaissance en vba sont trop limites.

Merci d'avance

Habiler

Donc, si je comprends bien,
la valeur de A1 est un nom de fichier ?

oui c'est cela
A1 = C:/XX/A1.pdf

HAbiler

Bonjour à tous,

en autodidacte, je ne peux pas voir toutes les erreurs,
mais je ferai qu'une seule procédure (la macro),
il manque aussi la valeur de cRow
donc, je te mets en premier tes 2 macros avec quelques commentaires (en vert, elles sont comprises par VBA avec l'apostrophe

à adapter et tester

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
82
83
84
85
86
87
88
89
90
Option Explicit
 
 
Dim titleName As String
Dim firstName As String
Dim lastName As String
Dim fullName As String
Dim clientEmail As String
Dim ccEmail As String
Dim bccEmail As String
Dim emailMessage As String
 Dim cROw As Long
 
Sub GenerateInfo()
 
    Dim WS As Worksheet
    Dim lrow As Long
    'Dim cROw As Long 'est déclaré 2 fois, en public ci-dessus, c'est à dire qu'elle est reconnue sur toutes les macros du même module
 
 cROw = 2 ' On donne une valeur à cRow et on démarre la ligne à la ligne n°2 (numéro 1 en titre)
    Set WS = ActiveSheet ' Onglet actuel
 
    With WS ' Avec l'Onglet actuel...
        lrow = .Range("A" & .Rows.Count).End(xlUp).Row ' ici on compte le nombre de lignes, sens Bas vers le Haut
        Application.ScreenUpdating = False 'On fige l'écran, c'est à dire qu'on voit pas Excel travailler
 
                       For cROw = 2 To lrow ' Début de la boucle qui démarre à 2 jusqu'aux nombres de lignes que lrow à trouvé
                           If Not .Range("A" & cROw).Value = "" Then ' début de condition, si en cellule "A et numéro de ligne est différente de vide, alors :
 
                               firstName = .Range("C" & cROw).Value 'valeur de "C" de la même ligne
                               clientEmail = .Range("E" & cROw).Value ' adresse du mail client
 
                               Call SendEmail(cROw) 'appel de la procédure (macro) SendEmail ci-dessous
 
                               .Range("Y" & cROw).Value = "Yes" ' écriture de Yes en Y de la même ligne
                               .Range("Y" & cROw).Font.Color = vbGreen ' police en vert toujours en Y
 
                           Else ' sinon (c'est à dire, si la cellule A est vide, alors :
                               .Range("Y" & cROw).Value = "No" ' écriture e No en Y de la même ligne
                               .Range("Y" & cROw).Font.Color = vbRed ' police en rouge toujours en Y
                           End If ' fin de la condition
                       Next cROw ' prochaine boucle, qui est aussi le numéro de ligne
 
    End With ' fin de l'Onglet actuel
 
    Application.ScreenUpdating = True ' l'écran n'est plus figé, car Excel ne travaille plus
 
    MsgBox "Process completed!", vbInformation ' message d'information que Excel a terminé
 
End Sub
Sub SendEmail(cROw As Long) ' Nouvelle procédure (macro) qui lance Outlook
 
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim sigString As String
    Dim Signature As String
    Dim insertPhoto As String
    Dim photoSize As String
 
    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)
 
 
    emailMessage = " Hello " & _
                    "<p>  <strong> xxxxxxxxx </strong>." & _
                    "<p>." & _
                    "<p>E" & _
                    "<p>"
 
 
    With outlookMail
        .To = clientEmail 'ici l'adresse mail du client, j'ai donc enlevé l'apostrophe car ce n'est pas un commentaire
        .To = "moi@moi.com" 'mon adresse mail
        .CC = ""
        .BCC = ""
        .Subject = "xxxxxxxxxxxxxxxxxxx"
        .BodyFormat = 2
        .Attachments.Add "C:\xxx\" & Range("A" & cROw) & ".pdf"
        Debug.Print cROw
        .HTMLBody = emailMessage
        .Importance = 2
        '.ReadReceiptRequested = True
        .Display
        '.Send
 
    End With
 
    Set outlookApp = Nothing
    Set outlookMail = Nothing
End Sub

ci-dessous les 2 macros en une seule

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
82
83
84
85
86
87
88
89
90
91
92
93
Option Explicit
 
Sub GenerateInfoEnUneSeuleMacro()
 
    Dim titleName As String
Dim firstName As String
Dim lastName As String
Dim fullName As String
Dim clientEmail As String
Dim ccEmail As String
Dim bccEmail As String
Dim emailMessage As String
Dim cROw As Long
 
 
'déclarations pour Outlook
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim sigString As String
    Dim Signature As String
    Dim insertPhoto As String
    Dim photoSize As String
 
    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)
 
 
 
 
Dim WS As Worksheet
Dim lrow As Long
 
cROw = 2 ' On donne une valeur à cRow et on démarre la ligne à la ligne n°2 (numéro 1 en titre)
Set WS = ActiveSheet ' Onglet actuel
 
    With WS ' Avec l'Onglet actuel...
        lrow = .Range("A" & .Rows.Count).End(xlUp).Row ' ici on compte le nombre de lignes, sens Bas vers le Haut
        Application.ScreenUpdating = False 'On fige l'écran, c'est à dire qu'on voit pas Excel travailler
 
                       For cROw = 2 To lrow ' Début de la boucle qui démarre à 2 jusqu'aux nombres de lignes que lrow à trouvé
                           If Not .Range("A" & cROw).Value = "" Then ' début de condition, si en cellule "A et numéro de ligne est différente de vide, alors :
 
                               firstName = .Range("C" & cROw).Value 'valeur de "C" de la même ligne
                               clientEmail = .Range("E" & cROw).Value ' adresse du mail client
 
 
 
                                                  'on ne fait plus appel à la macro car elle est intégrée ci'dessous
                                                  emailMessage = " Hello " & _
                                                  "<p>  <strong> xxxxxxxxx </strong>." & _
                                                  "<p>." & _
                                                  "<p>E" & _
                                                  "<p>"
 
 
                                                  With outlookMail
                                                      .To = clientEmail 'ici l'adresse mail du client, j'ai donc enlevé l'apostrophe car ce n'est pas un commentaire
                                                      .To = "moi@moi.com" 'mon adresse mail
                                                      .CC = ""
                                                      .BCC = ""
                                                      .Subject = "xxxxxxxxxxxxxxxxxxx"
                                                      .BodyFormat = 2
                                                      .Attachments.Add "C:\xxx\" & Range("A" & cROw) & ".pdf" 'attention si en A1 il ne faut pas que le nom de ton fichier est écrit .PDF, sinon déclaré 2 fois
                                                      Debug.Print cROw
                                                      .HTMLBody = emailMessage
                                                      .Importance = 2
                                                      '.ReadReceiptRequested = True
                                                      .Display
                                                      '.Send
 
                                                  End With
 
                                                   Set outlookApp = Nothing
                                                   Set outlookMail = Nothing
 
 
 
                               .Range("Y" & cROw).Value = "Yes" ' écriture de Yes en Y de la même ligne
                               .Range("Y" & cROw).Font.Color = vbGreen ' police en vert toujours en Y
 
                           Else ' sinon (c'est à dire, si la cellule A est vide, alors :
                               .Range("Y" & cROw).Value = "No" ' écriture e No en Y de la même ligne
                               .Range("Y" & cROw).Font.Color = vbRed ' police en rouge toujours en Y
                           End If ' fin de la condition
                       Next cROw ' prochaine boucle, qui est aussi le numéro de ligne
 
    End With ' fin de l'Onglet actuel
 
    Application.ScreenUpdating = True ' l'écran n'est plus figé, car Excel ne travaille plus
 
    MsgBox "Process completed!", vbInformation ' message d'information que Excel a terminé
 
End Sub