Discussion :

[nocky2019]

Bonjour à tous,

J'essaie de faire un code VBA, mais je suis nouvelle dans le codage.

J'ai un tableau avec Plusieurs colonnes.
La colonne A = les noms (clients)
colonne B, C, D, E, F, G, H = les informations sur les clients
Colonne I = adresses mail
Il peut y avoir des doublons dans les noms, se qui se répercute sur les adresses mails

L'idée est d'envoyer un seul mail automatiquement à chacun des clients avec uniquement ces lignes à lui.

Voici ma premier macro pour les données et pour les doublons adresse mails.

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
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Sub RecupererDataFichier()
 
    'Déclaration des variables
    Dim Listefichier As Variant
    Dim ws_data As Worksheet
    Dim Onglet As Worksheet
    Dim Monclasseur As Workbook
    Dim derniere_ligne As Long
    Dim dernire_colonne As Long
 
    'Désactiver le presse-papier pour éviter le stockage et Raffraichissement de l'écran
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
 
    'Effacer les anciennes données
    ActiveSheet.Range("A8").CurrentRegion.Clear
 
    'Récupérer le fichier des données à copier
    Listefichier = Application.GetOpenFilename(Title:="Sélectionner un fichier", _
    filefilter:="Fichiers Excel(*.xls*),*xls*", ButtonText:="Cliquez")
 
 
    'Prévoir le cas du bouton annuler
    If Listefichier <> False Then
 
        'Affecter le fichier sélectionné
        Set Monclasseur = Application.Workbooks.Open(Listefichier)
 
        'Copier les données de la feuille du classeur sélectionné
        Monclasseur.Sheets("sheet1").Range("X1:X10000,S1:S10000,Y1:Y10000,C1:C10000,F1:F10000,H1:H10000,M1:M10000,B1:B10000,AB1:AB10000").Copy
 
        'Coller les données dans la feuille active
        ThisWorkbook.ActiveSheet.Range("A8").PasteSpecial Paste:=xlPasteAll
 
        'Désactiver les messages d'alerte de Microsoft
        Application.DisplayAlerts = False
        'Fermer le classeur source
        Monclasseur.Close
 
    End If
 'SuppDoublonsMail Macro
    Range("J9").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(IF(COUNTIF(R9C9:RC[-1],RC[-1])>1,"""",RC[-1])="""","""",RC[-1])"
    Range("J9").Select
    Selection.AutoFill Destination:=Range("J9:J302")
    Range("J9:J302").Select
    Selection.Copy
    Range("I9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J9").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
 
end sub[/COLOR][/I] 
 
 
 
[INDENT][COLOR=#0000ff]Sub EnvoyerEmail()
'   selectionner la feuille de calcul "sheet1"
Sheets("Data").Select
 
 
' EnvoyerEmail Macro
Dim leMail As Variant
Dim Ligne As Integer
Dim oOutlook As Object
Set oOutlook = CreateObject("Outlook.Application")
Dim oMail As Object
Set oMail = oOutlook.CreateItem(0)
Dim cel As Variant
 
 
'création d'un objet Outlook
Set leMail = CreateObject("Outlook.Application")
 
 
For Ligne = 9 To 10
 
    With leMail.CreateItem(olMailItem)
 
'Dim oObjetWord As Object
'Set oObjetWord = .GetInspector.WordEditor
 
    For Each cel In Range("I9:I" & Range("I9").End(xlDown).Row)
 
        .Subject = "Réception des PO OBS à faire dans x-tracker " & Range("A" & Ligne)
        .To = cel
        .CC = "orders.obs@orange.com"
        .Body = "Bonjour" & vbCr & " " & vbCr & "Merci de réceptionner vos commandes, afin de mettre les factures de vos fournisseurs en paiement." & vbCr & " " & vbCr & "Merci d'avance !" & vbCr & " " & vbCr & "Equipe Finance"
        'Range("Tableau2").Select
        'Selection.Copy
        'oObjetWord.Range(100).Paste
        .Display
        '.Send
 
        'leMail.Quit
        'Set oleMail = Nothing
        'Set oMsg = Nothing
        'MsgBox "Mails Envoyés"
 
    End With
 
Set email = Nothing
 
'Next cel
 
Next Ligne
 
End Sub

Merci D'avance pour votre aide.

[User]

Bonjour,

Il y a des choses à corriger dans votre code :

Bien déclarer au début les variables objet et créer les objets Outlook dans le bon ordre :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
    Dim oOutlook as Object
    Dim oMail As Object
 
    'création d'un objet Outlook.Application
    Set oOutlook = CreateObject("Outlook.Application")
    '...
     for ligne=2 to ligneMax
         'création d'un objet olMailItem
        Set oMail = oOutlook.CreateItem(0) ' olMailItem=0
        ...
    Next ligne
    '....

Le bloc with ... end with devrait entourer les lignes concernant les mise à jour des propriétés de l'objet olMailItem. Idéalement dans la boucle For each cel....

Pourquoi pas utiliser une seule boucle for pour parcourir chaque ligne du tableau des clients au lieu de 2 boucles, et ajouter également une gestion d'erreur :

Code VBA :

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
Sub EnvoyerEmail()
    On error goto err_EnvoyerMail
    Dim oOutlook as Object
    Dim oMail As Object
 
    'création d'un objet Outlook.Application
    Set oOutlook = CreateObject("Outlook.Application")
 
    LigneMax = ActiveSheet.Cells(ActiveSheet.Columns(1).Cells.Count, 1).End(xlUp).Row
 
    for ligne=2 to ligneMax
         'création d'un objet olMailItem
        Set oMail = oOutlook.CreateItem(0) ' olMailItem=0
        with oMail
            .Subject = "Réception des PO OBS à faire dans x-tracker " & ActiveSheet.Range("A" & Ligne) ' colonne A
            .To = ActiveSheet.("I" & Ligne) ' Colonne I des e-mails
            '....
        end with
 
    next ligne
    '...
    set oMail=Nothing
    Set oOutlook = Nothing    
    Exit Sub 
 
err_EnvoyerMail:
     MsgBox(Err.Description)
     . . . 
     Resume
 
End Sub

[nocky2019]

Bonjour User,

Oui en effet j'ai refait les déclarations.

Cependant, j'ai un message d'erreur au niveau de

Code :

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

To = ActiveSheet.("I" & Ligne)

Merci d'avance!

[User]

Bonjour,

Oui, j'avais laissé une coquille :

Code :

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

To = Activesheet.Range("i" & ligne)

Cdlt,

[nocky2019]

Merci, ça marche bien

Je n'arrive toujours pas à sélectionner les lignes du tableau correspondants aux noms du clients afin de le rajouter dans le corps du mail.

Et comment sauter les adresses mails qui se répètent.

Pouvez-m'aidez ?

Merci d'avance User.

[User]

Vous pouvez obtenir le nom du client dans une variable en allant le chercher dans la colonne :

Code VBA :

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

1
2
3
NomClient = ActiveSheet.Range("A" & ligne)
 
...

Pour sauter les adresses qui se répètent, il faut 2 boucles je crois :

Code VBA :

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
ligne=2
 
do while ligne<=ligneMax
 
    email=ActiveSheet.Range("I" & Ligne)
 
    'création d'un objet olMailItem
    Set oMail = oOutlook.CreateItem(0) ' olMailItem=0
    with oMail
        .Subject = "Réception des PO OBS à faire dans x-tracker " & ActiveSheet.Range("A" & Ligne) ' colonne A
        .To =  email ' Colonne I des e-mails
        '....
    end with
 
    do while email=ActiveSheet.Range("I" & Ligne)
        ligne = ligne+1
        if  ligne>ligneMax then exit do
    Loop 
 
Loop

Cdlt,