XL 2010 Ajustement code VBA + Envoi mail multiple

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Saumon80

XLDnaute Occasionnel
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


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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
447
  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
818
Réponses
2
Affichages
809
Retour