Vyskytl se problém s uspořádáním distribuce dopisů podle seznamu uživatelů e-mailu v Excelu. Navíc v každém dopise musíte určit některá data, která jsou individuální pro každého uživatele. Tuto funkci jsem se pokusil implementovat pomocí makra vba v Excelu, který odesílá poštu prostřednictvím poštovního profilu aplikace Outlook nakonfigurovaného v počítači. Níže je moje rozhodnutí.
Předpokládejme, že máme soubor Excel obsahující následující sloupce:
E-mail uživatele Celé jméno | Čas poslední změny hesla | Stav účtu
V rámci mého úkolu musí každý uživatel ze seznamu poslat dopis formuláře:
Téma: Stav účtu v doméně winitpro.ruTělo dopis: Vážený% FullUsername%
Váš účet v doméně winitpro.ru je% status%
Čas poslední změny hesla:% pwdchange%Tip. Pokud potřebujete pro uživatelské účty získat hodnotu jednoho z uživatelských atributů ve službě Active Directory, můžete pomocí řešení z článku Excel Function získat uživatelská data z AD.
Vytvořit nové makro: kartu Zobrazit -> Makra. Zadejte název makra send_email a stiskněte tlačítko Vytvořit:
V editoru VBA, který se otevře, vložte následující kód (poskytl jsem mu všechny potřebné komentáře). K automatizaci zasílání dopisů použiji funkci CreateObject („Outlook.Application“), která vám umožní vytvořit a použít objekt aplikace Outlook ve skriptu.
Sub send_email ()
Dim olapp jako objekt
Dim olMailItm jako objekt
Dim iCounter jako celé číslo
Dim dest jako varianta
Dim SDest as String
předmět
strSubj = "Stav účtu v doméně winitpro.ru"
On Error GoTo dbg
'vytvořte nový objekt typu Outlook
Nastavit olApp = CreateObject ("Outlook.Application")
Pro iCounter = 1 do WorksheetFunction.CountA (sloupce (1))
'vytvořit novou položku (písmeno) v aplikaci Outlook
Nastavit olMailItm = olApp.CreateItem (0)
strBody = ""
useremail = Buňky (iCounter, 1) .Hodnota
FullUsername = Cells (iCounter, 2) .Value
Status = Cells (iCounter, 4) .Value
pwdchange = Buňky (iCounter, 3) .Hodnota
'' tvoří tělo dopisu
strBody = "Dear" & FullUsername & vbCrLf
strBody = strBody & "Váš účet v doméně winitpro.ru" & Stav & vbCrLf
strBody = strBody & "Čas poslední změny hesla:" & pwdchange & vbCrLf
olMailItm.To = useremail
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 1
„1 - textový formát dopisu, 2 - formát HTML
olMailItm.Body = strBody
olMailItm.Send
'další řádek lze použít k ladění textu dopisu komentováním předchozího
'MsgBox strBody
Nastavit olMailItm = Nic
Další iCounter
Nastavit olApp = Nic
dbg:
Chybové zobrazení, pokud existuje
Pokud Err.Description "" Potom MsgBox Err.Description
Konec sub
Tento soubor Excel musí být uložen s příponou xlsm (Formát sešitu Excel s podporou makra). Chcete-li zahájit distribuci, vyberte vytvořenou proceduru (makro) a klikněte na tlačítko Provést.
Makro postupně zařadí všechny řádky v listu aplikace Excel, vygeneruje a odešle jedno písmeno každému e-mailu ze seznamu..
