Envoie de mail Outlook depuis un formulaire vba

**antoinernould** · 27/04/2018, 10h22

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 :

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
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 :

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
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 !

**lucasgaetan** · 27/04/2018, 11h54

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 :

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
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

**antoinernould** · 27/04/2018, 12h08

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

**lucasgaetan** · 27/04/2018, 13h55

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

essaie ça voir:

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
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

**antoinernould** · 27/04/2018, 14h11

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 !