Senden Sie Blatt(e) an eine oder mehrere Personen, die VBA in Microsoft Excel verwenden

Anonim

Neues Blatt hinzufügen, Blattnamen in Mail ändern.
Jede E-Mail, die Sie senden möchten, verwendet 3 Spalten.

  1. in Spalte A - geben Sie den Namen des Blattes oder der Blätter ein, die Sie senden möchten.
  2. in Spalte B - E-Mail-Adresse eingeben.
  3. in Spalte C - der Betrefftitel wird oben in der E-Mail-Nachricht angezeigt.

Spalte A:C geben Informationen für die erste Mail ein und Sie können Spalten D:F für die zweite verwenden.
Sie können auf diese Weise 85 verschiedene E-Mails versenden (85*3 = 255 Spalten).

 Sub Mail_sheets() Dim MyArr As Variant Dim last As Long Dim shname As Long Dim a As Integer Dim Arr() As String Dim N As Integer Dim strdate As String For a = 1 To 253 Step 3 If ThisWorkbook.Sheets("mail" ).Cells(1, a).Value = "" Dann Unteranwendung beenden.ScreenUpdating = False last = ThisWorkbook.Sheets("mail").Cells(Rows.Count, a).End(xlUp).Row N = 0 For shname = 1 Zum letzten N = N + 1 ReDim Preserve Arr(1 To N) Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname, a).Value Nächster shname ThisWorkbook.Worksheets(Arr). Kopieren strdate = Format(Datum, "dd-mm-yy") & " " & Format(Time, "h-mm-ss") ActiveWorkbook.SaveAs "Teil von " & ThisWorkbook.Name _ & " " & strdate & " .xls" With ThisWorkbook.Sheets("mail") MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, a + 1).End(xlUp)) End With ActiveWorkbook.SendMail MyArr , ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value ActiveWorkbook.ChangeFileAccess xlReadOnly Kill ActiveWorkbook.FullName ActiveWorkbook.Close False Application.ScreenUpdating = True Weiter a End Sub