Cum se trimite fiecare foaie la diferite adrese de e-mail din Excel?
Dacă aveți un registru de lucru cu mai multe foi de lucru și există o adresă de e-mail în celula A1 a fiecărei foi. Acum, doriți să trimiteți fiecare foaie din registrul de lucru ca atașament destinatarului corespunzător din celula A1 individual. Cum ați putea rezolva această sarcină în Excel? În acest articol, voi introduce un cod VBA pentru a trimite fiecare foaie ca atașament la o adresă de e-mail diferită din Excel.
Trimiteți fiecare foaie la diferite adrese de e-mail din Excel cu cod VBA
Următorul cod VBA vă poate ajuta să trimiteți fiecare foaie ca atașament către diferiți destinatari, vă rugăm să procedați astfel:
1. presa Alt + F11 tastele simultan pentru a deschide Microsoft Visual Basic pentru aplicații fereastră.
2. Apoi apasa Insera > Moduleși copiați și inserați codul VBA de mai jos în fereastră.
Cod VBA: trimiteți fiecare foaie ca atașament la diferite adrese de 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 este celula care conține adresa de e-mail la care doriți să trimiteți e-mailul. Vă rugăm să le schimbați în funcție de nevoile dvs.
- Puteți specifica CC, BCC, Subiect, Corp în codul dvs.;
- Pentru a trimite e-mailul direct fără a deschide următoarea fereastră de mesaj nouă, trebuie să o schimbați .Afişa la .Trimite.
3. Apoi, apăsați F5 tasta pentru a rula acest cod și fiecare foaie este inserată automat în noua fereastră de mesaj ca atașament, vezi captura de ecran:
4. În cele din urmă, trebuie doar să faceți clic Trimiteți butonul pentru a trimite fiecare e-mail unul câte unul.
Cele mai bune instrumente de productivitate de birou
Îmbunătățiți-vă abilitățile Excel cu Kutools pentru Excel și experimentați eficiența ca niciodată. Kutools pentru Excel oferă peste 300 de funcții avansate pentru a crește productivitatea și a economisi timp. Faceți clic aici pentru a obține funcția de care aveți cea mai mare nevoie...
Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară
- Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
- Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ferestrele noi.
- Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
