Discussion :

[Kaytilou]

Bonjour,
A partir d'une base de données excel, je souhaite envoyé un mail personnalisé reprenant les données de mes cellules. J'ai tenté d'écrire un code, mais je me trouve bloquer car cela bug.

Le principe est de sélectionner une cellule d'une ligne
De cliquer sur le bouton "Mail d'envoi des clés de Licence"
Derrière ce mail, se cache le code suivant se basant sur un mail (le code source du mail se trouve dans l'onglet Liste), les champs devant se compléter automatiquement

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
'' ##############################################################
'' This is launched when the user clicks to create a PO
'' ##############################################################
Public Sub CreateCleLicenceMail_Click()
Dim oMailApp As Object   '' Outlook.Application
Dim oMail As Object      '' Outlook.MailItem
Dim sMailBody As String
Dim oWS As Worksheet
 
    Set oWS = ActiveSheet
    sMailBody = Sheets("Liste").Range("MailBody1") & Sheets("Liste").Range("MailBody2") & Sheets("Liste").Range("MailBody3")
    sMailBody = Replace(sMailBody, "%%Num?ro de commande%%", oWS.Cells(ActiveCell.Row, cmFCNumCommande))
    sMailBody = Replace(sMailBody, "%%Date de commande%%", Format(oWS.Cells(ActiveCell.Row, cmFCDateCommande), "dd mmmm yyyy"))
    sMailBody = Replace(sMailBody, "%%Identifiant 1%%", oWS.Cells(ActiveCell.Row, cmFCIdentifiant1))
    sMailBody = Replace(sMailBody, "%%Cl? Licence 1%%", oWS.Cells(ActiveCell.Row, cmFCCle1))
    sMailBody = Replace(sMailBody, "%%Identifiant 2%%", oWS.Cells(ActiveCell.Row, cmFCIdentifiant2))
    sMailBody = Replace(sMailBody, "%%Cl? Licence 2%%", oWS.Cells(ActiveCell.Row, cmFCCle2))
    sMailBody = Replace(sMailBody, "%%Identifiant 3%%", oWS.Cells(ActiveCell.Row, cmFCIdentifiant3))
    sMailBody = Replace(sMailBody, "%%Cl? Licence 3%%", oWS.Cells(ActiveCell.Row, cmFCCle3))
    sMailBody = Replace(sMailBody, "%%Identifiant 4%%", oWS.Cells(ActiveCell.Row, cmFCIdentifiant4))
    sMailBody = Replace(sMailBody, "%%Cl? Licence 4%%", oWS.Cells(ActiveCell.Row, cmFCCle4))
    sMailBody = Replace(sMailBody, "%%Identifiant 5%%", oWS.Cells(ActiveCell.Row, cmFCIdentifiant5))
    sMailBody = Replace(sMailBody, "%%Cl? Licence 5%%", oWS.Cells(ActiveCell.Row, cmFCCle5))
 
    Set oMailApp = CreateObject("Outlook.Application")
    Set oMail = oMailApp.CreateItem(0)  '' olMailItem
    With oMail
        .To = [cmFCMail]
        .Subject = "Votre commande [" & cmFCNumCommande & "][" & Format(cmFCDateCommande, "dd mmmm yyyy") & "] - Cl? de licence"
        .BodyFormat = 2    '' olFormatHTML
        .HTMLBody = sMailBody
        .Display
    End With
 
    Set oMailApp = CreateObject("Outlook.Application")
    Set oMail = oMailApp.CreateItem(0)  '' olMailItem
    With oMail
        .To = oWS.Cells(ActiveCell.Row, cmFCMail)
        .Subject = "Votre commande [" & Format(oWS.Cells(ActiveCell.Row, cmFCDateCommande), "dd mmmm yyyy") & "] pour [" & oWS.Cells(ActiveCell.Row, cmFCNumCommande) & "]"
        .BodyFormat = 2    '' olFormatHTML
        .HTMLBody = sMailBody
        .Display
    End With
 
End Sub

Voici le fichier déjà bien avancé.
Merci pour votre aide
Bonne journée