Bonjour,
J'ai trouve dans un site anglophone de programmation le code d'une programmation me permettant d'envoyer un email en appuyant sur une commande macro depuis un fichier Excel.
Cette macro ouvre une fenetre d'envoi d'email avec le fichier excel joint en piece jointe et le nom du destinataire.
Le nom du destinataire est d'apres le nom inscrit dans la cellule B4 (dans mon cas).
Le probleme est que cette programmation concerne toutes les feuilles d'Excel et elle ouvre des emails pour chaque feuille.
Je voudrais corriger cette programmation pour qu'elle ne s'active que d'apres la cellule B4 de la presente feuille de calculs (ActiveSheet, et non ActiveWorkbook)
Voici la programmation , et merci pour votre aide!!!
Sub Mail_Every_Worksheet()
'Working in 2000-2007
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = sh.Range("B4").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Set OutMail = Nothing
Kill TempFilePath & TempFileName & FileExtStr
Next sh
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
