Her sayfa Excel'den farklı e-posta adreslerine nasıl gönderilir?
Birkaç çalışma sayfası içeren bir çalışma kitabınız varsa ve her sayfanın A1 hücresinde bir e-posta adresi varsa. Şimdi, çalışma kitabındaki her sayfayı ek olarak A1 hücresindeki ilgili alıcıya ayrı ayrı göndermek istiyorsunuz. Bu görevi Excel'de nasıl çözebilirsiniz? Bu makalede, her sayfayı Excel'den farklı bir e-posta adresine ek olarak göndermek için bir VBA kodu tanıtacağım.
Her sayfayı VBA koduyla Excel'den farklı e-posta adreslerine gönderin
Aşağıdaki VBA kodu, her sayfayı ek olarak farklı alıcılara göndermenize yardımcı olabilir, lütfen şu şekilde yapın:
1. Basın Alt + F11 anahtarları aynı anda açmak için Uygulamalar için Microsoft Visual Basic pencere.
2. Daha sonra, Ekle > modül, ve aşağıdaki VBA kodunu kopyalayıp pencereye yapıştırın.
VBA kodu: Her sayfayı farklı e-posta adreslerine ek olarak gönderin
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 hücre, e-postayı göndermek istediğiniz e-posta adresini içerir. Lütfen bunları ihtiyacınıza göre değiştirin.
- Kodda CC, BCC, Konu, Gövdeyi kendinize göre belirleyebilirsiniz;
- Aşağıdaki yeni mesaj penceresini açmadan e-postayı doğrudan göndermek için, değiştirmeniz gerekir. .Görüntüle için `s.
3. Daha sonra, tuşuna basın. F5 tuşuna basın ve her sayfa otomatik olarak ek olarak yeni mesaj penceresine eklenir, ekran görüntüsüne bakın:
4. Son olarak, tıklamanız yeterlidir Gönder her e-postayı tek tek göndermek için düğme.
En İyi Ofis Üretkenlik Araçları
Excel Becerilerinizi Güçlendirin Kutools for Excelve Verimliliği Daha Önce Hiç Olmadığı Şekilde Deneyimleyin. Kutools for Excel Üretkenliği Artırmak ve Zamandan Tasarruf Etmek için 300'den Fazla Gelişmiş Özellik Sunar. En Çok İhtiyacınız Olan Özelliği Almak İçin Buraya Tıklayın...
Office Tab Sekmeli arabirimi Office'e getirir ve İşinizi Çok Daha Kolay Hale Getirir
- Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
- Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
- Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
