MACRO MAIL
Bonjour à tous,
J'ai chopé sur le net une macro pour selectionner une plage de donnée sur excel pour pouvoir l'envoyer par la suite en corp de mail sur outlook.
Sauf que ca bug à un moment. Pourriez vous m'aider. Je ne suis pas autant avisé sur VBA que certain sur ce forum :
Merci pour votre aide.
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, "", "").PublishTrue
' 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
Bonjour
as tu vérifié que tu avais le droit d’écrire dans le dossier c:\temp\ ??? si tu es avec une session utilisateur sur ton ordinateur le problème vient peut-être de là...
éventuellement change le chemin d'enregistrement dans un dossier où tu es sur de pouvoir ecrire...
fred
Merci fred pour ton aiguillage.
Cdt
Axou