Salt la conținutul principal

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
notițe: În codul de mai sus:
  • 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

Caracteristici populare: Găsiți, evidențiați sau identificați duplicatele   |  Ștergeți rândurile goale   |  Combinați coloane sau celule fără a pierde date   |   Rundă fără Formula ...
Super căutare: VLookup cu mai multe criterii    VLookup cu valori multiple  |   VLookup pe mai multe foi   |   Căutare fuzzy ....
Listă derulantă avansată: Creați rapid o listă derulantă   |  Listă drop-down dependentă   |  Listă derulantă cu selectare multiplă ....
Manager de coloane: Adăugați un număr specific de coloane  |  Mutați coloanele  |  Comutați starea vizibilității coloanelor ascunse  |  Comparați intervale și coloane ...
Caracteristici prezentate: Focus pe grilă   |  Vedere de proiectare   |   Big Formula Bar    Manager registru de lucru și foi   |  Biblioteca de resurse (Text automat)   |  Data Picker   |  Combinați foi de lucru   |  Criptare/Decriptare celule    Trimiteți e-mailuri după listă   |  Super Filtru   |   Filtru special (filtrează bold/italic/barat...) ...
Top 15 seturi de instrumente12 Text Instrumente (Adăuga text, Eliminați caractere,...)   |   50+ Diagramă Tipuri de (Gantt Chart,...)   |   40+ Practic Formule (Calculați vârsta pe baza zilei de naștere,...)   |   19 inserare Instrumente (Introduceți codul QR, Inserați imaginea din cale,...)   |   12 Convertire Instrumente (Numere la cuvinte, conversie valutara,...)   |   7 Merge & Split Instrumente (Rânduri combinate avansate, Celule divizate,...)   |   ... și altele

Î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 kte 201905


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!
Comments (4)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Does anyone know how to do this exactly but attach Files as PDF Is there an add on code that will convert the Excel to PDF to send via email as well at all. I tried changing the File EXT to .PDF instead of . XLS and .XLSM it attaches a File as PDF but doesn't open the PDF as a recognised File

thanks
This comment was minimized by the moderator on the site
Hello, Jo,
To send the attach files as PDF , please apply the following code:
Sub Mail_Every_Worksheet_As_PDF()
    'Updated by ExtendOffice to send each worksheet as a PDF
    Dim xWs As Worksheet
    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") & "\"
    Set xOlApp = CreateObject("Outlook.Application")
    For Each xWs In ThisWorkbook.Worksheets
        If xWs.Range("A1").Value Like "?*@?*.?*" Then
            xFileName = xWs.Name & " of " _
                         & VBA.Left(ThisWorkbook.Name, VBA.InStr(ThisWorkbook.Name, ".") - 1)
            xWs.Copy
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xTempFilePath & xFileName & ".pdf", Quality:=xlQualityStandard
            
            Set xMailObj = xOlApp.CreateItem(0)
            With xMailObj
                'specify the CC, BCC, Subject, Body below
                .To = xWs.Range("A1").Value
                .CC = ""
                .BCC = ""
                .Subject = "This is the Subject line"
                .Body = "Hi there"
                .Attachments.Add xTempFilePath & xFileName & ".pdf"
                .Display
            End With
            ActiveWorkbook.Close SaveChanges:=False
            Kill xTempFilePath & xFileName & ".pdf"
            Set xMailObj = Nothing
        End If
    Next
    Set xOlApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


Please have a try, Hope this can help you!
This comment was minimized by the moderator on the site
This works well, just what i was needing. Is there an add on code that will convert the Excel to PDF to send via email as well at all.

thanks
This comment was minimized by the moderator on the site
This is awesome! Thanks for this code!

Only thing I'd like, is there a way to copy values instead of links in the sheets?
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations