Bonjour a tous,
J'utilise le code VBA ci-dessous afin d'envoyer par email un classeur excel.
Je souhaiterai savoir ce que je dois modifier afin de n'envoyer que l'onglet actif situé sur la page sur laquelle se trouve le bouton envoyer et non pas le classeur entier?
Je souhaitais aussi savoir si je pouvait envoyer 2 onglet du même classeur a 2 email différent en même temps avec un seul clic sur le bouton envoyer ?
Merci d avance
J'utilise le code VBA ci-dessous afin d'envoyer par email un classeur excel.
Je souhaiterai savoir ce que je dois modifier afin de n'envoyer que l'onglet actif situé sur la page sur laquelle se trouve le bouton envoyer et non pas le classeur entier?
Je souhaitais aussi savoir si je pouvait envoyer 2 onglet du même classeur a 2 email différent en même temps avec un seul clic sur le bouton envoyer ?
Merci d avance
Code:
Private Sub Mail_workbook_Outlook_2()
'Mail a copy of the ActiveWorkbook with another file name
Dim wb1 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileNameStr As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb1 = ActiveWorkbook
FileNameStr = Range("AT1").Value
'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = FileNameStr
FileExtStr = ".xlsm"
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = Range("ah2") & ";" & Range("ah3") & ";" & Range("ah4")
.CC = Range("AO11")
.BCC = Range("AO5") & ";" & Range("al5")
.Subject = ""
.Body = ""
.Attachments.Add TempFilePath & TempFileName & FileExtStr
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
'Delete the file
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub