MACRO MAIL

axou91

XLDnaute Nouveau
Bonjour à tous,

J'ai chopé sur le net une macro me permettant de selectionner une plage et de la mettre en corps e mail. Je l'ai adapté à ma sauce mais il y a aun bug quelque part (police en rouge). Je n'arrive pas à regler ce problème.
Quelqu'un pourrait t il m'aider ?
Merci:

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, "D:\Users\idco1_isy1\Desktop\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
 

axou91

XLDnaute Nouveau
Bonjour Lone wolf, j'ai bien activé ce que tu m'as indiqué plus haut. Ca ne fonctionne pas. Ca me fait : erreur d'execution 76, chemin d'accès introuvable.
Je vais selctionné un maximum d'objet dans OUTIL puis REFERENCE.
Ne connaissant pas très bien VBA, je ne pense ps qu'il s'agisse de ça mais qui ne tente rien n'a rien.

Merci pour ton aide
 

Lone-wolf

XLDnaute Barbatruc
Re

Je me répète: il faut changer _ par un point sur la ligne d'ouverture du fichier texte. J'ai fait une test, j'ai bien l'écriture dans le corps du mail. Et ça ne sert à rien d'activer 10 références. Tu décoche tout et tu fait un test.
 

Discussions similaires

Réponses
17
Affichages
1 K

Statistiques des forums

Discussions
311 725
Messages
2 081 948
Membres
101 850
dernier inscrit
Danigra