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
- S1 est la cellule contient l'adresse e-mail à laquelle vous souhaitez envoyer l'e-mail. Veuillez les modifier selon vos besoins.
- Vous pouvez spécifier le CC, le BCC, le Sujet, le Corps dans le code ;
- Pour envoyer l'e-mail directement sans ouvrir la nouvelle fenêtre de message suivante, vous devez modifier .Afficher à .Envoyer.
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.
Meilleurs outils de productivité bureautique
Améliorez vos compétences Excel avec Kutools for Excel et faites l'expérience d'une efficacité comme jamais auparavant. Kutools for Excel offre plus de 300 fonctionnalités avancées pour augmenter la productivité et gagner du temps. Cliquez ici pour obtenir la fonctionnalité dont vous avez le plus besoin...
Office Tab apporte une interface à onglets à Office et facilite grandement votre travail
- Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
- Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
- Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
