Φύλλο αλληλογραφίας σε ένα ή περισσότερα άτομα που χρησιμοποιούν VBA στο Microsoft Excel

Anonim

Προσθέστε νέο φύλλο, αλλάξτε το όνομα του φύλλου σε mail.
Κάθε μήνυμα που θέλετε να στείλετε θα χρησιμοποιεί 3 στήλες.

  1. στη στήλη Α - εισαγάγετε το όνομα φύλλου ή φύλλων που θέλετε να στείλετε.
  2. στη στήλη Β - πληκτρολογήστε τη διεύθυνση ηλεκτρονικού ταχυδρομείου.
  3. στη στήλη Γ - ο τίτλος του θέματος εμφανίζεται στο επάνω μέρος του μηνύματος ηλεκτρονικού ταχυδρομείου.

Στήλη A: C εισαγάγετε πληροφορίες για το πρώτο μήνυμα και μπορείτε να χρησιμοποιήσετε τις στήλες D: F για το δεύτερο.
μπορείτε να στείλετε 85 διαφορετικά E-mail με αυτόν τον τρόπο (85*3 = 255 στήλες).

 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 = "" Τότε Έξοδος από την Εφαρμογή. ScreenUpdating = False last = ThisWorkbook.Sheets ("mail"). Cells (Rows.Count, a). End (xlUp). Row N = 0 Για shname = 1 Να διαρκέσει N = N + 1 ReDim Preserve Arr (1 To N) Arr (N) = ThisWorkbook.Sheets ("mail"). Cells (shname, a). Value Next shname ThisWorkbook.Worksheets (Arr) Αντιγραφή strdate = Μορφή (Ημερομηνία, "dd-mm-yy") & "" & Format (Time, "h-mm-ss") ActiveWorkbook.SaveAs "Part of" & 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 Next a Τέλος υπο