Envoi d'une sélection de cellules Excel en réponse à un mail

**ddmot74** · 08/12/2019, 14h07

Bonjour,
Je suis novice et ne comprend pas tout dans toutes ces lignes de code, donc voici ce que je souhaite faire, en cliquant sur un bouton de pouvoir envoyer une sélection de cellule et de les coller en réponse a un mail sélectionné dans outlook .
Je me suis aidé de la fac pour mon code que j'ai essayé d'arranger.Hors le code me crée un nouveau mail avec les cellule copier plus le reply du mail sélectionné dans outlook sans les cellules.

Ci-dessous mon code et un fichier excel en exemple:

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
113
114
115
116
117
118
119
120
121
 
 
Option Explicit
 
'-----------------------------------------------------------------------
'
' Lit le contenu d'un fichier texte et retourne son
' contenu
'
'-----------------------------------------------------------------------
 
 Public Function ReadFile(sFileName) As String
 
Dim fso As Object, fFile As Object
Dim sTemp As String
 
   Set fso = CreateObject("Scripting.FileSystemObject")
 
   Set fFile = fso.OpenTextFile(sFileName, 1, False)
 
   sTemp = fFile.ReadAll
 
   fFile.Close
 
   Set fFile = Nothing
 
   ReadFile = sTemp
 
End Function
 
Sub PrepareOutlookMail(ByVal sFileName As String)
 
'Dim appOutlook As Outlook.Application
Dim oMail As Outlook.MailItem
Dim objReplyMail As Outlook.MailItem
Dim OutMail As Object
 
   'Set appOutlook = CreateObject("Outlook.Application")
 
   ' Si Outlook n'était pas ouvert, l'instruction
    ' ci-dessus aura eu pour conséquence de
    ' démarrer Outlook.
    'Ce type de démarrage par automation fait
    'apparaître une fenêtre de sécurité qui demande
    'à l'utilisateur de permettre au programme de
    'continuer.
    '
    'Le message est "A program is trying to send an
    'email.   Do you want to allow..."
    '
    'Dans le cas où l'utilisateur aurait cliqué sur No,
    'l'objet appOutlook est égal à Nothing.  Il est
    'donc impossible de continuer.
 
   'If Not (appOutlook Is Nothing) Then
 
      Set oMail = ActiveExplorer.Selection(1)
      Set objReplyMail = oMail.Reply
      objReplyMail.Display
 
      objReplyMail.BodyFormat = olFormatHTML
 
      oMail.HTMLBody = ReadFile(sFileName)
 
      oMail.Display
 
      'Set oMail = Nothing
      'Set appOutlook = Nothing
 
   'End If
 
End Sub
 
 
'-----------------------------------------------------------------------
'
' La routine SendRangeByMail va proposer à
' l'utilisateur de sélectionner une plage de cellules
' en Excel et va ensuite envoyer cette plage par
' mail, dans le corps du mail.
'
'-----------------------------------------------------------------------
 
 Sub SendRangeByMail()
 
Dim rngeSend As Range
 
   With Application
 
      On Error Resume Next
 
      ' Demande à l'utilisateur de sélectionner la
      ' plage de cellule
 
      Set rngeSend = .InputBox(Prompt:="Please select range you wish to send.", Type:=8, Default:=.Selection.Address)
 
      ' rngeSend Is Nothing lorsque l'utilisateur ne fait
      ' aucun choix
 
       If rngeSend Is Nothing Then Exit Sub
 
      On Error GoTo 0
 
      ' Exporte la plage vers un fichier de type HTML;
      ' ceci afin de respecter la mise en page de la
      ' plage
 
      .ActiveWorkbook.PublishObjects.Add(4, "C:\Temp\XLRange.htm", rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True
 
      ' Appelle la routine qui va se charger de créer
      ' un mail
 
      Call PrepareOutlookMail("C:\Temp\XLRange.htm")
 
      ' Le fichier HTML n'est plus nécessaire
 
      Kill "C:\Temp\XLRange.htm"
 
   End With ' With Application
 
End Sub

Suite au post dans la section excel ou l'on ma redirigé ici. pour voir l'historique
Classeur1.xlsm
Je vous remercie d'avance pour votre aide.

**Oliv-** · 09/12/2019, 09h15

Bonjour,
J'ai rectifié cette partie.

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
Sub PrepareOutlookMail(ByVal sFileName As String)
 
    Dim appOutlook As Outlook.Application
    Dim oMail As Outlook.MailItem
    Dim objReplyMail As Outlook.MailItem
 
    Set appOutlook = CreateObject("Outlook.Application")
 
    ' Si Outlook n'était pas ouvert, l'instruction
    ' ci-dessus aura eu pour conséquence de
    ' démarrer Outlook.
    'Ce type de démarrage par automation fait
    'apparaître une fenêtre de sécurité qui demande
    'à l'utilisateur de permettre au programme de
    'continuer.
    '
    'Le message est "A program is trying to send an
    'email.   Do you want to allow..."
    '
    'Dans le cas où l'utilisateur aurait cliqué sur No,
    'l'objet appOutlook est égal à Nothing.  Il est
    'donc impossible de continuer.
 
    If Not (appOutlook Is Nothing) Then
 
    'pour prendre soit le mail ouvert soit le mail selectionné selon la fenêtre active.
        Dim obj As Object
        Set obj = appOutlook.ActiveWindow
        If TypeOf obj Is Outlook.Inspector Then
            Set obj = obj.CurrentItem
        Else
            Set obj = obj.Selection(1)
        End If
 
        If obj.Class <> olMail Then Exit Sub
 
        Set oMail = obj
 
        Set objReplyMail = oMail.Reply
        objReplyMail.Display
 
        objReplyMail.BodyFormat = olFormatHTML
 
        objReplyMail.HTMLBody = ReadFile(sFileName) & objReplyMail.HTMLBody
 
        objReplyMail.Display
 
        'Set oMail = Nothing
        'Set appOutlook = Nothing
 
    End If
 
End Sub

**ddmot74** · 09/12/2019, 18h26

Bonjour, Oliv-

Trop fort pile poil ce que je voulais

, ça marche chez moi, je teste ça au boulot demain.
Et je reviens mettre ça en résolu.
Un grand merci a toi.

**ddmot74** · 10/12/2019, 14h20

Bonjour, Oliv-
Le code fonctionne bien même avec le fichier sur le serveur réseau.
Par contre, si outlook est fermé cela fait une erreur: {erreur d’exécution '91 ' : variable objet ou variable de bloc with non definie}
Mais ce n'est pas gênant.
Merci

**Oliv-** · 11/12/2019, 15h56

Voici pour corriger, dans la cas où outlook est fermé tu n'as pas sélectionné de Mail donc je stoppe la macro

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
Sub PrepareOutlookMail(ByVal sFileName As String)
 
    Dim appOutlook As Outlook.Application
    Dim oMail As Outlook.MailItem
    Dim objReplyMail As Outlook.MailItem
 
    Set appOutlook = CreateObject("Outlook.Application")
 
    ' Si Outlook n'était pas ouvert, l'instruction
    ' ci-dessus aura eu pour conséquence de
    ' démarrer Outlook.
    'Ce type de démarrage par automation fait
    'apparaître une fenêtre de sécurité qui demande
    'à l'utilisateur de permettre au programme de
    'continuer.
    '
    'Le message est "A program is trying to send an
    'email.   Do you want to allow..."
    '
    'Dans le cas où l'utilisateur aurait cliqué sur No,
    'l'objet appOutlook est égal à Nothing.  Il est
    'donc impossible de continuer.
 
    If Not (appOutlook Is Nothing) Then
 
        'pour prendre soit le mail ouvert soit le mail selectionné selon la fenêtre active.
        Dim obj As Object
        Set obj = appOutlook.ActiveWindow
 
        If obj Is Nothing Then Set obj = appOutlook.Explorers.Add(appOutlook.Session.GetDefaultFolder(olFolderInbox)): obj.Display: MsgBox "Veuillez selectionner l'email", vbCritical: End
 
        If TypeOf obj Is Outlook.Inspector Then
            Set obj = obj.CurrentItem
        Else
            Set obj = obj.Selection(1)
        End If
 
        If obj.Class <> olMail Then Exit Sub
 
        Set oMail = obj
 
        Set objReplyMail = oMail.Reply
        objReplyMail.Display
 
        objReplyMail.BodyFormat = olFormatHTML
 
        objReplyMail.HTMLBody = ReadFile(sFileName) & objReplyMail.HTMLBody
 
        objReplyMail.Display
 
        'Set oMail = Nothing
        'Set appOutlook = Nothing
 
    End If
 
End Sub

**ddmot74** · 11/12/2019, 17h05

Bonjour,
Merci pour tout Oliv-
Affaire résolu donc.
Bonne continuation et bonne fête de fin d'année.

**ddmot74** · 13/12/2019, 10h11

Bonjour,
Je reviens vers vous car j'ai découvert un autre problème " missing: microsoft outlook 16.0 object library ", il y a une personne qui travail sur ce fichier avec office 2016 et moi 2013.
A priori l'erreur ne ce produit que chez moi avec office 2013.
Est-il possible de faire quelque chose sur le code, sans passer par l'achat d'office 2016?

Envoyé par Oliv-

Voici pour corriger, dans la cas où outlook est fermé tu n'as pas sélectionné de Mail donc je stoppe la macro

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
Sub PrepareOutlookMail(ByVal sFileName As String)
 
    Dim appOutlook As Outlook.Application
    Dim oMail As Outlook.MailItem
    Dim objReplyMail As Outlook.MailItem
 
    Set appOutlook = CreateObject("Outlook.Application")
 
    ' Si Outlook n'était pas ouvert, l'instruction
    ' ci-dessus aura eu pour conséquence de
    ' démarrer Outlook.
    'Ce type de démarrage par automation fait
    'apparaître une fenêtre de sécurité qui demande
    'à l'utilisateur de permettre au programme de
    'continuer.
    '
    'Le message est "A program is trying to send an
    'email.   Do you want to allow..."
    '
    'Dans le cas où l'utilisateur aurait cliqué sur No,
    'l'objet appOutlook est égal à Nothing.  Il est
    'donc impossible de continuer.
 
    If Not (appOutlook Is Nothing) Then
 
        'pour prendre soit le mail ouvert soit le mail selectionné selon la fenêtre active.
        Dim obj As Object
        Set obj = appOutlook.ActiveWindow
 
        If obj Is Nothing Then Set obj = appOutlook.Explorers.Add(appOutlook.Session.GetDefaultFolder(olFolderInbox)): obj.Display: MsgBox "Veuillez selectionner l'email", vbCritical: End
 
        If TypeOf obj Is Outlook.Inspector Then
            Set obj = obj.CurrentItem
        Else
            Set obj = obj.Selection(1)
        End If
 
        If obj.Class <> olMail Then Exit Sub
 
        Set oMail = obj
 
        Set objReplyMail = oMail.Reply
        objReplyMail.Display
 
        objReplyMail.BodyFormat = olFormatHTML
 
        objReplyMail.HTMLBody = ReadFile(sFileName) & objReplyMail.HTMLBody
 
        objReplyMail.Display
 
        'Set oMail = Nothing
        'Set appOutlook = Nothing
 
    End If
 
End Sub

**Oliv-** · 13/12/2019, 10h50

il faut enlever dans le fichier excel la référence à Microsoft OUTLOOK xxx object library

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
Option Explicit
 
Sub PrepareOutlookMail(ByVal sFileName As String)
 
    Dim appOutlook As Object 'Outlook.Application
    Dim oMail As Object 'Outlook.MailItem
    Dim objReplyMail As Object 'Outlook.MailItem
 
    Set appOutlook = CreateObject("Outlook.Application")
    Const olFolderInbox = 6
    Const olMail = 43
    Const olFormatHTML = 2
 
    ' Si Outlook n'était pas ouvert, l'instruction
    ' ci-dessus aura eu pour conséquence de
    ' démarrer Outlook.
    'Ce type de démarrage par automation fait
    'apparaître une fenêtre de sécurité qui demande
    'à l'utilisateur de permettre au programme de
    'continuer.
    '
    'Le message est "A program is trying to send an
    'email.   Do you want to allow..."
    '
    'Dans le cas où l'utilisateur aurait cliqué sur No,
    'l'objet appOutlook est égal à Nothing.  Il est
    'donc impossible de continuer.
 
    If Not (appOutlook Is Nothing) Then
 
        'pour prendre soit le mail ouvert soit le mail selectionné selon la fenêtre active.
        Dim obj As Object
        Set obj = appOutlook.ActiveWindow
 
        If obj Is Nothing Then Set obj = appOutlook.Explorers.Add(appOutlook.Session.GetDefaultFolder(olFolderInbox)): obj.Display: MsgBox "Veuillez selectionner l'email", vbCritical: End
 
        If StrComp(TypeName(obj), "Inspector", vbTextCompare) = 0 Then
            Set obj = obj.CurrentItem
        Else
            Set obj = obj.Selection(1)
        End If
 
        If obj.Class <> olMail Then Exit Sub
 
        Set oMail = obj
 
        Set objReplyMail = oMail.Reply
        objReplyMail.Display
 
        objReplyMail.BodyFormat = olFormatHTML
 
        objReplyMail.HTMLBody = ReadFile(sFileName) & objReplyMail.HTMLBody
 
        objReplyMail.Display
 
        'Set oMail = Nothing
        'Set appOutlook = Nothing
 
    End If
 
End Sub

**ddmot74** · 17/12/2019, 00h20

Bonjour, Oliv-
Merci pour ta rapidité, ça fonctionne parfaitement. merci.

Envoi d'une sélection de cellules Excel en réponse à un mail [OL-2013]

VBA Outlook

Discussions similaires

Partager

Partager