Ga naar hoofdinhoud

Hoe elk blad vanuit Excel naar verschillende e-mailadressen verzenden?

Als u een werkmap hebt met meerdere werkbladen en er is een e-mailadres in cel A1 van elk blad. Nu wilt u elk blad uit de werkmap als bijlage afzonderlijk naar de bijbehorende ontvanger in cel A1 sturen. Hoe zou je deze taak in Excel kunnen oplossen? In dit artikel zal ik een VBA-code introduceren om elk blad als bijlage naar een ander e-mailadres vanuit Excel te verzenden.


Stuur elk blad naar verschillende e-mailadressen vanuit Excel met VBA-code

De volgende VBA-code kan u helpen om elk blad als bijlage naar verschillende ontvangers te verzenden, doe dit als volgt:

1. pers Alt + F11 toetsen tegelijkertijd om het Microsoft Visual Basic voor toepassingen venster.

2. Dan klikken Invoegen > Module, en kopieer en plak de onderstaande VBA-code in het venster.

VBA-code: stuur elk blad als bijlage naar verschillende e-mailadressen

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
Note: In de bovenstaande code:
  • S1 is de cel die het e-mailadres bevat waarnaar u de e-mail wilt verzenden. Verander ze naar uw behoefte.
  • U kunt de CC, BCC, Onderwerp, Body naar uw eigen in de code specificeren;
  • Om de e-mail rechtstreeks te verzenden zonder het volgende nieuwe berichtvenster te openen, moet u het volgende wijzigen: .Scherm naar .Versturen.

3. Druk vervolgens op F5 toets om deze code uit te voeren, en elk blad wordt automatisch als bijlage in het nieuwe berichtvenster ingevoegd, zie screenshot:

4. Ten slotte hoeft u alleen maar te klikken Verzenden knop om elke e-mail één voor één te verzenden.

Beste Office-productiviteitstools

🤖 Kutools AI-assistent: Een revolutie teweegbrengen in de data-analyse op basis van: Intelligente uitvoering   |  Genereer code  |  Aangepaste formules maken  |  Analyseer gegevens en genereer grafieken  |  Roep Kutools-functies aan...
Populaire functies: Zoek, markeer of identificeer duplicaten   |  Verwijder lege rijen   |  Combineer kolommen of cellen zonder gegevens te verliezen   |   Ronde zonder formule ...
Super opzoeken: Meerdere criteria VLookup    VLookup met meerdere waarden  |   VOpzoeken over meerdere bladen   |   Fuzzy opzoeken ....
Geavanceerde vervolgkeuzelijst: Maak snel een vervolgkeuzelijst   |  Afhankelijke vervolgkeuzelijst   |  Multi-select vervolgkeuzelijst ....
Kolom Beheerder: Voeg een specifiek aantal kolommen toe  |  Kolommen verplaatsen  |  Schakel de zichtbaarheidsstatus van verborgen kolommen in  |  Vergelijk bereiken en kolommen ...
Uitgelichte functies: Raster focus   |  Ontwerpweergave   |   Grote formulebalk    Werkmap- en bladbeheer   |  resource Library (Auto-tekst)   |  Datumkiezer   |  Combineer werkbladen   |  Cellen coderen/decoderen    Stuur e-mails per lijst   |  Super filter   |   Speciaal filter (filter vet/cursief/doorhalen...) ...
Top 15 gereedschapsets12 Tekst Tools (toe te voegen tekst, Tekens verwijderen, ...)   |   50+ tabel Types (Gantt Chart, ...)   |   40+ Praktisch Formules (Bereken leeftijd op basis van verjaardag, ...)   |   19 Invoeging Tools (QR-code invoegen, Afbeelding invoegen vanaf pad, ...)   |   12 Camper ombouw Tools (Getallen naar woorden, Currency Conversion, ...)   |   7 Samenvoegen en splitsen Tools (Geavanceerd Combineer rijen, Gespleten cellen, ...)   |   ... en meer

Geef uw Excel-vaardigheden een boost met Kutools voor Excel en ervaar efficiëntie als nooit tevoren. Kutools voor Excel biedt meer dan 300 geavanceerde functies om de productiviteit te verhogen en tijd te besparen.  Klik hier om de functie te krijgen die u het meest nodig heeft...

Omschrijving


Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert honderden muisklikken voor u elke dag!
Comments (5)
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 perfectly thanks so much
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