Envoie de mail Outlook depuis un formulaire vba

Version imprimable

Bonjour,

Je dois actuellement développer une application excel permettant à l'utilisateur de choisir (parmi une liste prédéfinie) un mail type et que selon le mail type sélectionné, s'affiche des textbox pour que l'utilisateur remplisse les informations nécessaires pour remplir les parties du mail type qui contient des balises (exemple : #TEL) pour les remplacer par ce qu'il doit mettre. Voici un exemple de ce que j'ai fait
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 Private Sub ChoixMailType_Change() '///////////////////////// 01 ////////////////// If ChoixMailType.Value = "01-ASTREINTE IM Samedi XX.oft" Then For Each Ctrl In Me.Controls If TypeName(Ctrl) = "Label" And Ctrl.Name <> "LabelJM01" And Ctrl.Name <> "LabelTel01" Then Ctrl.Visible = False Else If TypeName(Ctrl) = "TextBox" And Ctrl.Name <> "TextBoxJM01" And Ctrl.Name <> "TextBoxTel01" Then Ctrl.Visible = False Else If TypeName(Ctrl) = "ComboBox" And Ctrl.Name <> "ChoixMailType" Then Ctrl.Visible = False Else If TypeName(Ctrl) = "CommandButton" And Ctrl.Name <> "Valider" Then Ctrl.Visible = False Else Ctrl.Visible = True End If End If End If End If Next Ctrl End If End Sub
Jusque la tout va bien, ce type de code ne me pose pas de problème.

Vient ensuite la partie mail, lorsque l'utilisateur a rentré ses données dans les textbox, il faut qu'il appuie sur le bouton valider.
J'avais déjà du gérer l'envoie de mail par vba, mais tout était créé en HTML, je pourrai procéder de la même façon sauf que j'ai 29 mails types donc impossible.

Voici le code (non fonctionnel) pour la partie mail. Ce que je veux que ce code fasse est que il ouvre le mail outlook en changeant les balises adéquates.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Private Sub Valider_Click() Dim AD As String AD = ThisWorkbook.Path & "\" & MailingType.ChoixMailType.Value 'MailingType étant le formulaire et ChoixMailType le combobox contenant la liste des mails types. If ChoixMailType.Value = "01-ASTREINTE IM Samedi XX.oft" Then Set AppOtk = CreateObject(Outlook.Application) 'le bug est à cette ligne Set DocOft = AppOtk.Session.OpenSharedItem(AD) With DocOft .Bookmarks("#JM").Range.Text = TextBoxJM01.Value .Bookmarks("#TEl").Range.Text = TextBoxTel01.Value End With End If Unload Me End Sub
En espérant avoir bien détaillé mon problème et que quelqu'un puisse m'apporter son savoir !

Merci !

bonjour antoinernould,

Pour envoyer un mail j'utilise ça, à toi de l’améliorer.
tu peux jouer sur la variable sPhrase(), ou mettre en automatique les champ OutMail.To .CC .....

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
Sub Envoi_emailTemp()
Dim OutApp              As Outlook.Application
Dim OutMail             As Outlook.MailItem
Dim LettreLangue        As String
Dim i                   As Long
Dim sPhrase(4)          As String
 
 
    sPhrase(0) = "Envois de plans - Commande "
    sPhrase(1) = "Bonjour "
    sPhrase(2) = ", <BR>Trouvez ci-joint les plans references ci-dessous, tous les plans avec un indice precedent doivent etre detruits ou archives.<BR><BR>"
    sPhrase(3) = "<BR><BR>Nous vous souhaitons bonne reception de ces documents et vous prions d'agreer nos salutations distinguees.<BR>"
    sPhrase(4) = "<BR>Cordialement<BR>"
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
    With OutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = sPhrase(0) & UserFormHistoriqueEnvoisPlans.TxtBxNoAffaire.Value     'Ajout No Cmd
    Dim strHTML As String
    strHTML = ""
    strHTML = strHTML & "<HEAD>"
    strHTML = strHTML & "<BODY>"
    strHTML = strHTML & sPhrase(1) & sPhrase(2)
    strHTML = strHTML & sPhrase(3)
    strHTML = strHTML & sPhrase(4) & Application.UserName
    strHTML = strHTML & "</BODY>"
    strHTML = strHTML & ""
 
    .HTMLBody = strHTML
 
    .Display
 
 
    End With
 
On Error GoTo 0
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

27/04/2018, 12h08
antoinernould

Cette façon d'envoyer les mails je la gère assez bien, la ce que je veux c'est ouvrir un mail type déjà existant et remplacer des balises (avec les Bookmarks), du coup cette solution ne me va pas, si ça avait été qu'un mail oui, mais comme dit plus haut j'ai 29 mails type à gérer

autant pour moi, je n'avais pas compris ta demande

essaie ça voir:

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
Sub test()
Dim MonFichier As String
 
Dim AD As String
 
AD = ThisWorkbook.Path & "\" & MailingType.ChoixMailType.Value 'MailingType étant le formulaire et ChoixMailType le combobox contenant la liste des mails types.
 
If ChoixMailType.Value = "01-ASTREINTE IM Samedi XX.oft" Then   
    Dim OutApp              As Outlook.Application
    Dim OutMail             As Outlook.MailItem
    Dim myInspector         As Outlook.Inspector
    Dim wdDoc               As Object
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItemFromTemplate(AD)
    OutMail.Display 'Option: Pour afficher le message
 
     Set myInspector = OutMail.GetInspector
     Set wdDoc = myInspector.WordEditor
 
    With wdDoc
         .Bookmarks("#JM").Range.Text = TextBoxJM01.Value
        .Bookmarks("#TEl").Range.Text = TextBoxTel01.Value
    End With
End If
Unload Me   
End Sub

27/04/2018, 14h11
antoinernould

MERCI BEAUCOUP !

Je viens de découvrir à l'aide d'un autre site l'ajout de signet sur Outlook, du coup avec ton code en plus ça marche !

Par contre saurais tu comment faire pour faire la même chose dans le sujet ?

Mais quand même merci beaucoup !
27/04/2018, 14h18
lucasgaetan

as-tu testé ?

Code:

OutMail.Subject = "ce que tu veux"

car les signets ne sont pas dispo dans le sujet
27/04/2018, 14h24
antoinernould

Un grand merci ! Du coup pour le titre j'ai mit "Le titre de base" & Textbox.Value

Mais un grand merci quand même, je crois que tu dois être la première personne à donner cette solution sur internet ^^
27/04/2018, 14h43
VBA_PADAWAN

Bonjour lucasgaetan,

Merci beaucoup tu gères !!!!!!!!