Kako iz Excela poslati vsak list na različne e-poštne naslove?
Če imate delovni zvezek z več delovnimi listi in je v celici A1 vsakega lista e-poštni naslov. Zdaj želite poslati vsak list iz delovnega zvezka kot prilogo ustreznemu prejemniku v celici A1 posebej. Kako bi lahko rešili to nalogo v Excelu? V tem članku bom predstavil kodo VBA za pošiljanje vsakega lista kot priloge na drug e-poštni naslov iz Excela.
Pošljite vsak list na različne e-poštne naslove iz Excela s kodo VBA
Naslednja koda VBA vam lahko pomaga pri pošiljanju vsakega lista kot priloge različnim prejemnikom, naredite takole:
1. Pritisnite Alt + F11 tipke hkrati, da odprete Microsoft Visual Basic za aplikacije okno.
2. Nato kliknite Vstavi > Moduli, ter kopirajte in prilepite spodnjo kodo VBA v okno.
Koda VBA: pošljite vsak list kot prilogo na različne e-poštne naslove
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 celica vsebuje e-poštni naslov, na katerega želite poslati e-pošto. Spremenite jih glede na vaše potrebe.
- V kodi lahko določite CC, BCC, Subject, Body;
- Če želite poslati e-pošto neposredno, ne da bi odprli naslednje okno za novo sporočilo, morate spremeniti .Prikaz do .Pošlji.
3. Nato pritisnite F5 za zagon te kode in vsak list se samodejno vstavi v okno za novo sporočilo kot priloga, glejte posnetek zaslona:
4. Nazadnje morate le še klikniti Pošlji gumb za pošiljanje vsakega e-poštnega sporočila enega za drugim.
Najboljša pisarniška orodja za produktivnost
Napolnite svoje Excelove spretnosti s Kutools za Excel in izkusite učinkovitost kot še nikoli prej. Kutools za Excel ponuja več kot 300 naprednih funkcij za povečanje produktivnosti in prihranek časa. Kliknite tukaj, če želite pridobiti funkcijo, ki jo najbolj potrebujete...
Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo
- Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
- Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
- Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!