Come inviare ogni foglio a indirizzi email diversi da Excel?

Se hai una cartella di lavoro Excel con più fogli di lavoro, ognuno contenente un indirizzo email nella cella S1, potresti voler inviare ogni foglio come allegato separato al rispettivo destinatario. Questo compito può essere noioso se fatto manualmente, specialmente quando si ha a che fare con un gran numero di fogli. In questo tutorial, ti mostreremo come utilizzare il codice VBA per inviare automaticamente ogni foglio di lavoro del tuo file Excel come allegato all'indirizzo email specificato nella cella S1 di ogni foglio.

Invia ogni foglio a indirizzi email diversi da Excel con il codice VBA

Il seguente codice VBA ti permetterà di inviare ogni foglio di lavoro come allegato al destinatario corrispondente elencato nella cella S1. Segui questi passaggi:

1. Premi contemporaneamente i tasti Alt+ F11 per aprire la finestra Microsoft Visual Basic for Applications.

2. Successivamente, clicca su Inserisci > Modulo, e copia e incolla il seguente codice VBA nella finestra.

Codice VBA: Invia ogni foglio come allegato a indirizzi email diversi

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. Successivamente, premi il tasto F5 per eseguire questo codice, e ogni foglio viene inserito automaticamente nella finestra del nuovo messaggio come allegato, vedi screenshot:

4. Infine, clicca sul pulsante Invia per inviare ogni email una per una.

Kutools per Excel: Invia Email Personalizzate Facilmente con un Solo Clic!

Stanco di inviare email ai clienti una per una? Con la funzione “Invia Email” di Kutools per Excel, la comunicazione diventa più veloce e professionale! Basta preparare un foglio di lavoro Excel con nomi, indirizzi email, codici di registrazione e inserire segnaposto — il sistema genererà automaticamente email personalizzate e ne invierà centinaia con un solo clic. Dì addio al lavoro ripetitivo!

• 💡 I segnaposto dinamici (ad esempio, nome, codice di registrazione) riempiono automaticamente contenuti personalizzati per ogni destinatario, garantendo che ogni email sembri unica e su misura.
• 📎 Allega file personalizzati per una consegna precisa
• 📤 Si integra perfettamente con Outlook per un invio sicuro e affidabile
• 📝 Salva e riutilizza modelli di email per massimizzare l'efficienza
• 🎨 Editor WYSIWYG facile da usare
• 🖋 Usa la tua firma di Outlook — nessuna configurazione aggiuntiva, basta premere invia!
• Ottieni Ora Kutools Per Excel!