Bonjour,

J'ai un classeur contenant une liste de noms (colonne C) et de prénoms (colonne D) et un email (colonne E). Je souhaiterais récupérer le nom et le prénom pour les mettre dans les cellules A22 (aligné à droite) et C22 (aligné à gauche) de la feuille 2, enregistrer cette feuille en pdf avec le format nom_prénom.pdf et envoyer un mail à ces personnes avec le pdf en pièce jointe. J'utilise déjà le code suivant pour envoyer des emails sous conditions mais je nage complétement pour le modifier...

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
Sub Emailpdf()
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
 
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    X = 0
    On Error GoTo cleanup
    For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "K").Value) = "fr" And _
           LCase(Cells(cell.Row, "T").Value) = "x" _
           And LCase(Cells(cell.Row, "U").Value) <> "send" Then
 
            Set OutMail = OutApp.CreateItem(0)
 
            On Error Resume Next
 
            With OutMail
                .To = cell.Value
                .Subject = ""
                .Body = "Bonjour," _
 
                        "Ceci est un message automatique merci de ne pas y répondre."
 
                .Send
            End With
            On Error GoTo 0
            Cells(cell.Row, "U").Value = "send"
            Set OutMail = Nothing
        ElseIf cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "K").Value) = "en" And _
           LCase(Cells(cell.Row, "T").Value) = "x" _
           And LCase(Cells(cell.Row, "U").Value) <> "send" Then
 
            Set OutMail = OutApp.CreateItem(0)
 
            On Error Resume Next
 
            With OutMail
                .To = cell.Value
                .Subject = ""
                .Body = "Hello," _
 
                        "This is an automatic message please do not reply."
                .Send
            End With
            On Error GoTo 0
            Cells(cell.Row, "U").Value = "send"
            Set OutMail = Nothing
        End If
    Next cell
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
bien cordialement,

olivier