Copier dans Excel et Coller dans Outlook en VBA

S

Skud

XLDnaute Junior
Bonjour à tout le forum,

J’ai adapté un code trouvé ici même (par avance désolé car je ne me souviens plus du nom de l’auteur…) pour l’envoi d’un mail à partir d’Excel.

Tout fonctionne à l’exception d’un dernier petit problème : Un fois ma plage sélectionnée je n’arrive pas à la coller dans le corps de texte de mon message. Je dois faire le Collage à la main.

Voilà le code :

Code: 
Sub EnvoiMail()
Dim ol As Object, myItem As Object
Dim strHtml As String

Set Plage = ActiveSheet.Range("A1:J16")
Application.ScreenUpdating = False
Plage.CopyPicture Appearance:=xlScreen, Format:=xlPicture

strHtml = "Bonjour, <BR><BR>"
strHtml = strHtml & "Pouvez-vous me faire un retour concernant XXXXXXX ?"
strHtml = strHtml & "<BR><BR>"

'A cet emplacement je voudrais coller ma plage de données. La ligne ci dessous ne le permettant pas...

strHtml = strHtml & "<IMG align=baseline border=0 hspace=0 src=Selection.PasteAndFormat (wdPasteDefault)>"
strHtml = strHtml & "<BR><BR>" & _
"Cordialement," & "<BR><BR>"
strHtml = strHtml & "<B><font style='font-family: Arial ;font-size: 10pt ;' color=midnightblue>XXXXXXXXXX</Font></B>" & "<BR>"
strHtml = strHtml & "<font style='font-family: Arial ;font-size: 10pt ;' color=midnightblue>XXXXXXXXXXXXXXXX</Font>" & "<BR>"
strHtml = strHtml & "<font style='font-family: Arial ;font-size: 10pt ;' color=midnightblue>XXXXXXXXXXX</Font>" & "<BR>"
strHtml = strHtml & "<font style='font-family: Arial ;font-size: 10pt ;' color=midnightblue>XXXXXXXXXXXXX</Font>" & "<BR>"

Set ol = CreateObject("outlook.application")
Set myItem = ol.CreateItem(olMailItem)

myItem.To = Range("C22") & " ;" & Range("C23") & " ;" & Range("C24") & " ;" & Range("C25") & " ;" & Range("C26") & " ;" & Range("C27") & " ;" & Range("C28")
myItem.Subject = "Avancement : " & Range("F22")
myItem.HtmlBody = strHtml

myItem.display

Set ol = Nothing

End Sub

J'ai consulté pas mal de fils au sujet de l'envoi d'email mais ceux qui ont posés le même type de question sont malheureusement sans réponse.

Merci pour votre aide.

Bonne journée.
 
Trier par date Trier par votes
S

Skud

XLDnaute Junior
Re : Copier dans Excel et Coller dans Outlook en VBA

J'ai créé un fichier temporaire de l'image que j'ai collé avec ce code:

Code: 
Sub Image()

Dim Plage As Range
Set Plage = ActiveSheet.Range("A1:J16")
Application.ScreenUpdating = False
Workbooks.Add: Plage.CopyPicture: ActiveSheet.Paste
With ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height).Chart
.Paste
.Export "C:\Temp\Test.gif", "GIF"
End With
ActiveWorkbook.Close False
End Sub

Et j'ai indiqué comme source ce fichier temporaire au niveau de la ligne:

Code: 
strHtml = strHtml & "<IMG align=baseline border=0 hspace=0 src=C:\Temp\Test.gif>"

Bah ça marche pas !
Car il faut que les personnes à qui j'envoie le mail est accès à ce dossier et dès que je supprime le fichier temporaire, je n'ai plus rien dans mon mail envoyé...ni ceux à qui je l'ai envoyé...

Le fil reste donc bien ouvert !
 
Vote positif 0 Vote négatif
S

Skud

XLDnaute Junior
Re : Copier dans Excel et Coller dans Outlook en VBA

Bonjour Vbacrumble,

Merci de de jeter un coup d'oeil à mon problème ;-)

J'ai essayé la modif et rien à faire...
Dès que l'on supprime le fichier temporaire il n'y a plus rien dans le mail...
 
Vote positif 0 Vote négatif
J

jms31

XLDnaute Junior
Re : Copier dans Excel et Coller dans Outlook en VBA

bonjour,

Je ne vais pas faire beaucoup avancer la solution, mais je vais peut être préciser le problème.

Si ton image est locale, il faut que ton image soit intégrée dans le mail au format MIME multipart donc un codage ascii de l'image binaire.

Sinon il faut qu'elle soit hébérgé quelque part sur un serveur accessible de ton destinataire avec donc une URL Web complète http://www.monserveur.fr\monimage.jpg ....

Par contre pour encoder au format MIME et compléter les entêtes indiquant les diférentes parties du message peut être que tu trouvera des choses là IETF Request For Comments (RFCs)

voici un lien sur du code VB pour l'encodage base64 utilisé pour les pieces jointes binaire dans le MIME. Avec un peu de chance ça sera totalement compatible avec VBA.
http://www.paradoxes.info/code/base64.html
 
Dernière édition:
Vote positif 0 Vote négatif
J

jms31

XLDnaute Junior
Re : Copier dans Excel et Coller dans Outlook en VBA

J'ai trouvé ce bout de code qui utilise des fonctions intégrés dans le DOM XML

Il faut rajouter la référence à Microsoft XML à ton projet par le menu "outils->référence" dans VBE.

Code: 
Public Function Decode_Base64(Text As String) As String
  Dim Xml As New MSXML.DOMDocument
  Dim Conv As MSXML.IXMLDOMElement
  If Text = "" Then
    Decode_Base64 = ""
    Exit Function
  End If
  Set Conv = Xml.createElement("Base64")
  Conv.dataType = "bin.base64"
  Conv.Text = Text
  Decode_Base64 = StrConv(Conv.nodeTypedValue, vbUnicode)
End Function
Public Function Encode_Base64(Text As String) As String
  Dim Xml As New MSXML.DOMDocument
  Dim Conv As MSXML.IXMLDOMElement
  Dim Arr() As Byte
  If Text = "" Then
    Encode_Base64 = ""
    Exit Function
  End If
  Arr = StrConv(Text, vbFromUnicode)
  Set Conv = Xml.createElement("Base64")
  Conv.dataType = "bin.base64"
  Conv.nodeTypedValue = Arr
  Encode_Base64 = Conv.Text
End Function

désolé j'ai été trop vite le code est fait pour du texte et pas un fichier binaire
 
Dernière édition:
Vote positif 0 Vote négatif
S

Skud

XLDnaute Junior
Re : Copier dans Excel et Coller dans Outlook en VBA

Bonjour Jms31 et MichelXld,

Merci de vous être penchés sur mon problème.
Alors après une multitudes de tentatives vaines depuis hier soir je suis enfin parvenu à mes fins ce matin !

J'ai utilisé le code du site : To add an embedded image to an HTML message in Microsoft Outlook using code
Et ajouté la fonction de création de l'image et tout à l'air de fonctionné !

Je donne donc le code pour ceux que cela intéresse :

Code: 
'----------------------------------------------------
'
' Code provenant de : http://www.outlookcode.com/d/code/htmlimg.htm
'
' Il faut activer la référence : (dans Outils/Références)
' Microsoft CDO X.XX Library
' Microsoft Outlook X.XX Object Library
'
'----------------------------------------------------

Sub EmbeddedHTMLGraphicDemo()
  ' Outlook objects
  Dim objApp As Outlook.Application
  Dim l_Msg As MailItem
  Dim colAttach As Outlook.Attachments
  Dim l_Attach As Outlook.Attachment
  Dim oSession As MAPI.Session
  ' CDO objects
  Dim oMsg As MAPI.Message
  Dim oAttachs As MAPI.Attachments
  Dim oAttach As MAPI.Attachment
  Dim colFields As MAPI.Fields
  Dim oField As MAPI.Field
  
  Dim strEntryID As String
  Dim strHTML As String

'Appel de la fonction pour la crétion de l'image dans le répertoire c:\Temp

Image
  
  ' create new Outlook MailItem
  Set objApp = CreateObject("Outlook.Application")
  Set l_Msg = objApp.CreateItem(olMailItem)
  ' add graphic as attachment to Outlook message
  ' change path to graphic as needed
  Set colAttach = l_Msg.Attachments
  Set l_Attach = colAttach.Add("c:\Temp\test.gif")
  l_Msg.Close olSave
  strEntryID = l_Msg.EntryID
  Set l_Msg = Nothing
  ' *** POSITION CRITICAL *** you must dereference the
  ' attachment objects before changing their properties
  ' via CDO
  Set colAttach = Nothing
  Set l_Attach = Nothing
    
  ' initialize CDO session
  On Error Resume Next
  Set oSession = CreateObject("MAPI.Session")
  oSession.Logon "", "", False, False
  
  ' get the message created earlier
  Set oMsg = oSession.GetMessage(strEntryID)
  ' set properties of the attached graphic that make
  ' it embedded and give it an ID for use in an <IMG> tag
  Set oAttachs = oMsg.Attachments
  Set oAttach = oAttachs.Item(1)
  Set colFields = oAttach.Fields
  Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
  Set oField = colFields.Add(&H3712001E, "myident")
  oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
  oMsg.Update
  
  ' get the Outlook MailItem again
  Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
  ' add HTML content -- the <IMG> tag
  
strHTML = "Bonjour, <BR><BR>"
strHTML = strHTML & "Pouvez-vous me faire un retour concernant XXXXXXX ?"
strHTML = strHTML & "<BR><BR>"
strHTML = strHTML & "<IMG align=baseline border=0 hspace=0 src=cid:myident>"
strHTML = strHTML & "<BR><BR>" & _
"Cordialement," & "<BR><BR>"
strHTML = strHTML & "<B><font style='font-family: Arial ;font-size: 10pt ;' color=midnightblue>XXXXXXXXXX</Font></B>" & "<BR>"
strHTML = strHTML & "<font style='font-family: Arial ;font-size: 10pt ;' color=midnightblue>XXXXXXXXXXXXXXXX</Font>" & "<BR>"
strHTML = strHTML & "<font style='font-family: Arial ;font-size: 10pt ;' color=midnightblue>XXXXXXXXXXX</Font>" & "<BR>"
strHTML = strHTML & "<font style='font-fa"
  
  
  l_Msg.HTMLBody = strHTML
  l_Msg.Close (olSave)
  l_Msg.Display
  
  ' clean up objects
  Set oField = Nothing
  Set colFields = Nothing
  Set oMsg = Nothing
  oSession.Logoff
  Set oSession = Nothing
  Set objApp = Nothing
  Set l_Msg = Nothing
  
End Sub


Sub Image()

Dim Plage As Range
Set Plage = ActiveSheet.Range("A1:J16")
Application.ScreenUpdating = False
Workbooks.Add: Plage.CopyPicture: ActiveSheet.Paste
With ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height).Chart
.Paste
.Export "C:\Temp\Test.gif", "GIF"
End With
ActiveWorkbook.Close False
End Sub

Il y a peut-être une autre solution, notamment en utilisant le premier lien donné par MichelXld et le dernier code de la partie "Comment insérer une plage de cellules dans le corps du message ?", mais je n'y suis pas parvenu.

J'avais soit le tableau, soit le message, mais pas les 2 en même temps...

C'est dommage car cette solution ne créait pas une image mais insérer un tableau dans le corps du message (en conservant toute la mise en forme) et je pense que c'est l'idéal.

Si Jms31 ou MichelXld ont un peu de temps, je suis preneur de leur aide.
Voilà le code qui pour le moment ne fonctionne pas entièrement :

Code: 
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
 
'-----------------------------------------------------------------------'
' Cette routine va créer une instance de Outlook (si
' pas encore démarré) et va ensuite ouvrir une
' fenêtre de type mail.   Le corps du message sera
' initialisé avec le contenu d'un fichier de type
' HTML.   Ce fichier aura été préalablement
' créé par la routine SendRangeByMail
'
' Nécessite l'ajout d'une référence vers "Microsoft
' Outlook Object Library"
'
'-----------------------------------------------------------------------
 
 Sub PrepareOutlookMail(ByVal sFileName As String)
 
Dim appOutlook As Outlook.Application
Dim oMail 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
      
      Set oMail = appOutlook.CreateItem(olMailItem)
      
      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

Je n'ai pas réussi à intégrer du texte comme "Bonjour...." dans ce code.

Bonne journée.
 
Vote positif 0 Vote négatif
apnart

apnart

XLDnaute Occasionnel
Re : Copier dans Excel et Coller dans Outlook en VBA

Bonjour,

Je suis très intéressé par ce code, mais je n'arrive pas à l'adapter à mes besoins.

Dans ce code, on pose la question pour avoir la plage de cellules à copier, je voudrais pour ma part, soit la fixer en dur, soit mieux, pouvoir mettre la plage qui m'intéresse dans une cellule bien identifiée sur une feuille.

C'est possible ça ?

Le code en question :

Code: 
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
 
'-----------------------------------------------------------------------'
' Cette routine va créer une instance de Outlook (si
' pas encore démarré) et va ensuite ouvrir une
' fenêtre de type mail.   Le corps du message sera
' initialisé avec le contenu d'un fichier de type
' HTML.   Ce fichier aura été préalablement
' créé par la routine SendRangeByMail
'
' Nécessite l'ajout d'une référence vers "Microsoft
' Outlook Object Library"
'
'-----------------------------------------------------------------------
 
 Sub PrepareOutlookMail(ByVal sFileName As String)
 
Dim appOutlook As Outlook.Application
Dim oMail 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
      
      Set oMail = appOutlook.CreateItem(olMailItem)
      
      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

Un GRAND merci pour votre aide.

Amicalement,
Bruno.
 
Vote positif 0 Vote négatif
apnart

apnart

XLDnaute Occasionnel
Re : Copier dans Excel et Coller dans Outlook en VBA

Hello,

Bon bah j'ai réussi à trouver comme un grand...

L'instruction d'origine :
Code: 
Set rngeSend = .InputBox(Prompt:="Please select range you wish to send.", Type:=8, Default:=.Selection.Address)
ouvre une boite de dialogue qui permet de sélectionner la zone à copier.

C'est pas ce que je cherchais, alors voilà 2 autres solutions qui ne passent pas par la box qui pose une question :


--------------------------------------


1- Remplacer le code précédent par :
Code: 
Set rngeSend = Range("B2:D5")
Cela fixe la plage de copie, dans mon exemple de B2 à D5


--------------------------------------


2- Remplacer le code précédent par :
Code: 
Set rngeSend = Range(Cells(1, 2).Value)
Dans la cellule A2, j'ai écrit la zone à copier (ex: B2: D5 (sans espace))


--------------------------------------


Si ça peut en aider certain(e)s, j'en serait heureux :D

Amicalement,
Bruno.
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Résolu(e)
XL 2019 Enregistrer sous la feuille active dans répertoire du fichier père en vba
2
Réponses
23
Affichages
685
Fabrice16ct
F
M
  • Question
Microsoft 365 Joindre une copie de 2 feuilles Excel dans outlook
Réponses
0
Affichages
296
Mika07
M
Fredox
  • Question
VBA - Mailling texte variable
Réponses
3
Affichages
803
Hasco
Hasco
A
  • Question
XL 2019 Besoin d'aide pour copier les lignes d'un classeur et les coller dans un autre classeur par le bié d'un bouton (VBA)
Réponses
7
Affichages
757
aka100k
A
C
  • Question
Microsoft 365 Envoi mail excel vba avec copier coller spécial image
Réponses
0
Affichages
2 K
capc93
C
C
  • Question
Word VBA Excel-Word: Coller du texte l'un en dessous de l'autre
Réponses
1
Affichages
3 K
Conrad13
C
B
  • Question
XL 2016 Excel code VBA pour ajuster le contenu d’une plage sur 1 page
Réponses
3
Affichages
2 K
bouclesdor
B
jeanmax
  • Question
XL 2010 [MACRO] Copier une zone et la coller en image dans un email !
Réponses
3
Affichages
832
jeanmax
jeanmax
V
  • Question
Compatibilité Macro entre Excel 2010 et 2013
Réponses
4
Affichages
1 K
Roland_M
Roland_M
N
  • Question
Envoi d'un tableau HTML par Outlook + Signature par défaut Outlook
Réponses
3
Affichages
25 K
JNP
JNP

Membres actuellement en ligne

12 membres et 144 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 216
Messages
2 086 351
Membres
103 195
dernier inscrit
martel.jg