Postitaulukot yhdelle tai useammalle henkilölle, jotka käyttävät VBA: ta Microsoft Excelissä

Anonim

Lisää uusi arkki, muuta arkin nimi postiksi.
Jokainen lähetettävä viesti käyttää 3 saraketta.

  1. sarakkeeseen A - kirjoita arkin tai arkkien nimi, jonka haluat lähettää.
  2. sarakkeeseen B - kirjoita sähköpostiosoite.
  3. sarakkeessa C - aiheen otsikko näkyy sähköpostiviestin yläosassa.

Sarake A: C kirjoita ensimmäisen postin tiedot ja voit käyttää sarakkeita D: F toisessa.
Voit lähettää 85 erilaista sähköpostia tällä tavalla (85*3 = 255 saraketta).

 Sub Mail_sheets () Dim MyArr Vaihtoehtona Dim Last Long Dim shname As Long Dim a As Integer Dim Arr () Kuten String Dim N Kuten Integer Dim strdate Stringate For a = 1 to 253 Vaihe 3 If ThisWorkbook.Sheets ("mail" ) .Solut (1, a) .Value = "" Lopeta sitten Sub Application.ScreenUpdating = False last = ThisWorkbook.Sheets ("mail"). Solut (Rows.Count, a) .End (xlUp) .Row N = 0 Shname = 1 Viimeiseen N = N + 1 ReDim Preserve Arr (1 - N) Arr (N) = ThisWorkbook.Sheets ("mail"). Solut (shname, a) .Arvo Seuraava shname ThisWorkbook.Worksheets (Arr). Kopioi strdate = Muoto (päivämäärä, "pp-kk-vv") & "" & muoto (aika, "h-mm-ss") ActiveWorkbook.SaveAs "Osa" & ThisWorkbook.Name _ & "" & strdate & " .xls "With ThisWorkbook.Sheets (" mail ") MyArr = .Range (.Cells (1, a + 1), .Cells (Rows.Count, a + 1) .End (xlUp)) End ActiveWorkbook.SendMail MyArr , ThisWorkbook.Sheets ("mail"). Solut (1, a + 2) .Arvo ActiveWorkbook.ChangeFileAccess xlReadOnly Kill ActiveWorkbook.FullName ActiveWorkbook.Close False Application.ScreenUpdating = True Next a End Sub