Comment envoyer chaque feuille à différentes adresses email depuis Excel ?

Si vous avez un classeur avec plusieurs feuilles de calcul et qu'il y a une adresse e-mail dans la cellule A1 de chaque feuille. Maintenant, vous souhaitez envoyer chaque feuille du classeur en tant que pièce jointe au destinataire correspondant dans la cellule A1 individuellement. Comment pourriez-vous résoudre cette tâche dans Excel ? Cet article, je vais introduire un code VBA pour envoyer chaque feuille en pièce jointe à une adresse e-mail différente d'Excel.

---

Envoyez chaque feuille à différentes adresses e-mail à partir d'Excel avec le code VBA

Le code VBA suivant peut vous aider à envoyer chaque feuille en pièce jointe à différents destinataires, veuillez procéder comme suit :

1. presse Alt + F11 touches simultanément pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2. Puis clique insérer > Module, puis copiez et collez le code VBA ci-dessous dans la fenêtre.

Code VBA : envoyez chaque feuille en pièce jointe à différentes adresses e-mail

Sub Mail_Every_Worksheet()
'Updateby ExtendOffice
  Dim xWs As Worksheet
  Dim xWb As Workbook
  Dim xFileExt As String
  Dim xFileFormatNum As Long
  Dim xTempFilePath As String
  Dim xFileName As String
  Dim xOlApp As Object
  Dim xMailObj As Object
  On Error Resume Next
  With Application
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  xTempFilePath = Environ$("temp") & "\"
  If Val(Application.Version) < 12 Then
    xFileExt = ".xls": xFileFormatNum = -4143
  Else
    xFileExt = ".xlsm": xFileFormatNum = 52
  End If
  Set xOlApp = CreateObject("Outlook.Application")
  For Each xWs In ThisWorkbook.Worksheets
    If xWs.Range("S1").Value Like "?*@?*.?*" Then
      xWs.Copy
      Set xWb = ActiveWorkbook
      xFileName = xWs.Name & " of " _
                   & VBA.Left(ThisWorkbook.Name, VBA.InStr(ThisWorkbook.Name, ".") - 1) & " "
      Set xMailObj = xOlApp.CreateItem(0)
      xWb.Sheets.Item(1).Range("S1").Value = ""
      With xWb
        .SaveAs xTempFilePath & xFileName & xFileExt, FileFormat:=xFileFormatNum
        With xMailObj
        'specify the CC, BCC, Subject, Body below
            .To = xWs.Range("S1").Value
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add xWb.FullName
            .Display
        End With
        .Close SaveChanges:=False
      End With
      Set xMailObj = Nothing
      Kill xTempFilePath & xFileName & xFileExt
    End If
  Next
  Set xOlApp = Nothing
  With Application
      .ScreenUpdating = True
      .EnableEvents = True
  End With
End Sub

3. Puis appuyez F5 clé pour exécuter ce code, et chaque feuille est automatiquement insérée dans la nouvelle fenêtre de message en tant que pièce jointe, voir capture d'écran :

4. Enfin, il vous suffit de cliquer Envoyer bouton pour envoyer chaque e-mail un par un.