¿Cómo enviar cada hoja a diferentes direcciones de correo electrónico desde Excel?
Si tiene un libro de trabajo con varias hojas de trabajo y hay una dirección de correo electrónico en la celda A1 de cada hoja. Ahora, desea enviar cada hoja del libro de trabajo como un archivo adjunto al destinatario correspondiente en la celda A1 individualmente. ¿Cómo podrías resolver esta tarea en Excel? En este artículo, presentaré un código VBA para enviar cada hoja como un archivo adjunto a una dirección de correo electrónico diferente desde Excel.
Envíe cada hoja a diferentes direcciones de correo electrónico desde Excel con código VBA
El siguiente código de VBA puede ayudarlo a enviar cada hoja como un archivo adjunto a diferentes destinatarios, haga lo siguiente:
1. prensa Alt+F11 teclas simultáneamente para abrir el Microsoft Visual Basic para aplicaciones ventana.
2. Luego, haz clic recuadro > Móduloy copie y pegue el siguiente código VBA en la ventana.
Código VBA: envíe cada hoja como archivo adjunto a diferentes direcciones de correo electrónico
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 es la celda que contiene la dirección de correo electrónico a la que desea enviar el correo electrónico. Por favor, cámbielos según sus necesidades.
- Puede especificar CC, BCC, Asunto, Cuerpo a su gusto en el código;
- Para enviar el correo electrónico directamente sin abrir la siguiente ventana de mensaje nuevo, debe cambiar .Monitor a .Enviar.
3. Entonces presione F5 para ejecutar este código, y cada hoja se inserta en la nueva ventana de mensaje como un archivo adjunto automáticamente, vea la captura de pantalla:
4. Finalmente, solo necesitas hacer clic Enviar botón para enviar cada correo electrónico uno por uno.
Las mejores herramientas de productividad de oficina
Mejore sus habilidades de Excel con Kutools for Excel y experimente la eficiencia como nunca antes. Kutools for Excel ofrece más de 300 funciones avanzadas para aumentar la productividad y ahorrar tiempo. Haga clic aquí para obtener la función que más necesita...
Office Tab lleva la interfaz con pestañas a Office y hace que su trabajo sea mucho más fácil
- Habilite la edición y lectura con pestañas en Word, Excel, PowerPoint, Publisher, Access, Visio y Project.
- Abra y cree varios documentos en nuevas pestañas de la misma ventana, en lugar de en nuevas ventanas.
- ¡Aumenta su productividad en un 50% y reduce cientos de clics del mouse todos los días!
