XL 2013 Envoie par Email une sélection de cellule

degards

XLDnaute Junior
Bonjour à vous !!!

J'aimerais exporter une sélection de cellules de mon fichier vers Outlook afin d'envoyer un courriel de manière automatique. J'ai trouvé une solution qui pourrait faire l'affaire mais si jamais il y a une solution plus simple.

En résumé, j'aimerais que les cellules A1 à BK16 soient sélectionnées pour ensuite être copié dans un nouveau courriel dans Outlook. Le courriel devra être envoyé à une adresse précise avec un sujet précis. L'envoie devra être faite par la macro elle-même.

La sélection peut-être jointe en pièce jointe aussi en format PDF mais seulement la sélection.

Merci de votre aide
 

Fichiers joints

degards

XLDnaute Junior
J'ai aussi trouvé ce code que j'ai adapté mais si Outlook n'est pas ouvert le courriel ne s'envoie pas. Est-ce que vous savez pourquoi ?

Code:
Sub SendSelectedCells_inOutlookEmail()
    Dim objSelection As Excel.Range
    Dim objTempWorkbook As Excel.Workbook
    Dim objTempWorksheet As Excel.Worksheet
    Dim strTempHTMLFile As String
    Dim objTempHTMLFile As Object
    Dim objFileSystem As Object
    Dim objTextStream As Object
    Dim objOutlookApp As Outlook.Application
    Dim objNewEmail As Outlook.MailItem

    'Copy the selection
    ActiveSheet.Unprotect
    Range("A1:BK16").Select
    Range("BK16").Activate
    Selection.Copy
    Application.ScreenUpdating = False

    'Paste the copied selected ranges into a temp worksheet
    Set objTempWorkbook = Excel.Application.Workbooks.Add(1)
    Set objTempWorksheet = objTempWorkbook.Sheets(1)

    'Keep the values, column widths and formats in pasting
    With objTempWorksheet.Cells(1)
         .PasteSpecial xlPasteValues
         .PasteSpecial xlPasteColumnWidths
         .PasteSpecial xlPasteFormats
    End With

    'Save the temp worksheet as a HTML file
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    strTempHTMLFile = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Excel" & Format(Now, "YYYY-MM-DD hh-mm-ss") & ".htm"
    Set objTempHTMLFile = objTempWorkbook.PublishObjects.Add(xlSourceRange, strTempHTMLFile, objTempWorksheet.Name, objTempWorksheet.UsedRange.Address)
    objTempHTMLFile.Publish (True)

    'Create a new email
    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objNewEmail = objOutlookApp.CreateItem(olMailItem)

    'Read the HTML file data and insert into the email body
    Set objTextStream = objFileSystem.OpenTextFile(strTempHTMLFile)
    objNewEmail.HTMLBody = objTextStream.ReadAll
    objNewEmail.Display
    'You can specify the new email recipients, subjects here using the following lines:
    objNewEmail.To = "de****@hotnail.com"
    objNewEmail.Subject = "Bonjour"
    objNewEmail.Send '--> directly send out this email

    objTextStream.Close
    objTempWorkbook.Close (False)
    objFileSystem.DeleteFile (strTempHTMLFile)
    Range("i5").Select
    ActiveSheet.Protect
     Application.ScreenUpdating = True
   
End Sub
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir
degards
Juste de passage pour un petit conseil de "prudence" ;)
Il est conseillé de ne pas laisser son email tel quel dans les messages sur le forum
Mieux vaut faire parler les étoiles ;)
objNewEmail.To = "d******@domaine.***"
ou encore
objNewEmail.To = "degards@email.xxx"
 

zebanx

XLDnaute Accro
Bonjour Degards, Staple1600, le forum

@degards.
Le code en 2 fonctionne sans ouvrir outlook (2007).
Je crois que je vous ai envoyé un mail d'ailleurs :D.

Il faut cependant cocher dans l'éditeur VBE - outils - référence la case miscrosoft outlook .. object library.
Sinon ça fonctionne bien.

xl-ment
zebanx
 

degards

XLDnaute Junior
Bonjour Degards, Staple1600, le forum

@degards.
Le code en 2 fonctionne sans ouvrir outlook (2007).
Je crois que je vous ai envoyé un mail d'ailleurs :D.

Il faut cependant cocher dans l'éditeur VBE - outils - référence la case miscrosoft outlook .. object library.
Sinon ça fonctionne bien.

xl-ment
zebanx
Bonjour Zebanx, merci pour ta réponse mais de mon côté avec Outlook 2013 ça ne fonctionne pas. Pourtant la case de référence est bien cochée. Le courriel ce créé mais demeure dans ma boîte d'envoi si Outlook n'est pas ouvert. De plus lorsque j'ouvre Outlook, le courriel ne s'envoie pas automatiquement.

En résumé, pour le moment je dois m'assurer que Outlook est ouvert lorsque j'exécute le VBA en attendant de trouvé la solution.

Merci encore
 

degards

XLDnaute Junior
Bonsoir
degards
Juste de passage pour un petit conseil de "prudence" ;)
Il est conseillé de ne pas laisser son email tel quel dans les messages sur le forum
Mieux vaut faire parler les étoiles ;)
objNewEmail.To = "d******@domaine.***"
ou encore
objNewEmail.To = "degards@email.xxx"

Merci du conseil Staples 1600, j'avais oublié de les modifié.
 

zebanx

XLDnaute Accro
Re-

Ok.
Difficile à comprendre car on a bien l'instruction .send donc....

Sinon, j'ai trouvé un autre bout de code qui pourrait fonctionner. Cela semble activer une librairie récente sur outlook (v14) et le code est relativement concis pour envoyer une plage d'un tableau (bon descritptif et fichier joint avec code).

Ca vaut peut-être le coup de partir là-dessus. Désolé de ne pouvoir vous aider davantage
xl-ment
 

Discussions similaires


Haut Bas