Kirjalehed ühele või mitmele inimesele, kes kasutavad Microsoft Excelis VBA -d

Anonim

Lisage uus leht, muutke lehe nimi postiks.
Iga meil, mida soovite saata, kasutab 3 veergu.

  1. veergu A - sisestage lehe või lehtede nimi, mida soovite saata.
  2. veerus B - sisestage e -posti aadress.
  3. veerus C - teema pealkiri kuvatakse meilisõnumi ülaosas.

Veerg A: C sisestage esimese kirja andmed ja teise jaoks võite kasutada veerge D: F.
saate sel viisil saata 85 erinevat e-kirja (85*3 = 255 veergu).

 Alampost_lehed () Dim MyArr Variandina Dim viimati nii kaua Dim shname Nii kaua Dim a Täisarv Dim Arr () Stringina Dim N Täisarvuna Dim strdate Stringina a = 1 kuni 253 Samm 3 If ThisWorkbook.Sheets ("mail" ). Lahtrid (1, a) .Value = "" Seejärel väljuge alamrakendusest.ScreenUpdating = False last = ThisWorkbook.Sheets ("mail"). Lahtrid (Rows.Count, a) .End (xlUp) .Rida N = 0 Shname = 1 Viimasele N = N + 1 ReDim säilitab Arr (1 kuni N) Arr (N) = ThisWorkbook.Sheets ("mail"). Lahtrid (shname, a) .Väärtus Järgmine shname ThisWorkbook.Worksheets (Arr). Kopeeri strdate = Vorming (kuupäev, "pp-kk-aaa") & "" & vorming (aeg, "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"). Lahtrid (1, a + 2) .Väärtus ActiveWorkbook.ChangeFileAccess xlReadOnly Kill ActiveWorkbook.FullName ActiveWorkbook.Close False Application.ScreenUpdating = True Next a End Sub