Come inviare ogni foglio a diversi indirizzi e-mail da Excel?

Se si dispone di una cartella di lavoro con più fogli di lavoro e nella cella A1 di ciascun foglio è presente un indirizzo e-mail. Ora vuoi inviare ogni foglio dalla cartella di lavoro come allegato al destinatario corrispondente nella cella A1 individualmente. Come potresti risolvere questo compito in Excel? In questo articolo, introdurrò un codice VBA per inviare ogni foglio come allegato a un indirizzo e-mail diverso da Excel.

---

Invia ogni foglio a diversi indirizzi e-mail da Excel con codice VBA

Il seguente codice VBA può aiutarti a inviare ogni foglio come allegato a destinatari diversi, per favore fai come segue:

1. stampa Alt + F11 tasti contemporaneamente per aprire il file Microsoft Visual Basic, Applications Edition finestra.

2. Quindi, fare clic inserire > Moduloe copia e incolla il codice VBA sottostante nella finestra.

Codice VBA: invia ogni foglio come allegato a diversi indirizzi 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

3. Quindi, premere F5 chiave per eseguire questo codice e ogni foglio viene inserito automaticamente nella finestra del nuovo messaggio come allegato, vedi screenshot:

4. Infine, devi solo fare clic Invia pulsante per inviare ogni e-mail una per una.