Този урок ще ви покаже как да изпращате имейли от Excel чрез Outlook чрез VBA.
Изпращане на активната работна книга
| 1234567891011121314151617181920 | Функция SendActiveWorkbook (strTo As String, strSubject As String, Незадължително strCC As String, Незадължително strBody As String) Като BooleanНа грешка възобновяване следващоDim appOutlook As ObjectDim mItem As Object'създайте нов екземпляр на OutlookЗадайте appOutlook = CreateObject ("Outlook.Application")Задайте mItem = appOutlook .CreateItem (0)С mItem.To = strTo.CC = "".Subject = strSubject.Body = strBody.Допълнения.Добавете ActiveWorkbook.FullName'използвайте изпращане за незабавно изпращане или показване за показване на екрана.Display 'или .SendКрай с„почистване на предметиЗадайте mItem = НищоЗадайте appOutlook = НищоКрайна функция |
Горната функция може да бъде извикана чрез процедурата по -долу
| 123456789101112131415 | Sub SendMail ()Dim strTo As StringDim strSubject As StringDim strBody As String'попълнете променливиstrTo = "[email protected]"strSubject = "Моля, намерете прикачен финансов файл"strBody = "тук има текст за тялото на имейла"'извикайте функцията, за да изпратите имейлаАко SendActiveWorkbook (strTo, strSubject,, strBody) = true тогаваMsgbox „Успех при създаването на имейл“ИначеMsgbox "Създаването на имейл не бе успешно!"Край, акоEnd Sub |
Използване на Ранно свързване за препратка към библиотеката на обекти на Outlook
Кодът по -горе използва Късно свързване за препратка към обекта на Outlook. Можете да добавите препратка към Excel и да декларирате приложението Outlook и Outlook Mail Item с помощта на Early Binding, ако предпочитате. Ранното свързване прави кода да работи по -бързо, но ви ограничава, тъй като потребителят би трябвало да има същата версия на Microsoft Office на своя компютър.
Щракнете върху менюто Инструменти и Препратки, за да се покаже диалоговият прозорец за справка.
Добавете препратка към библиотеката на обекти на Microsoft Outlook за версията на Office, която използвате.
След това можете да промените кода си, за да използвате тези препратки директно.
Голямо предимство на ранното свързване са падащите списъци, които ви показват обектите, които са на разположение за използване!
Изпращане на един лист от активната работна книга
За да изпратите един лист, първо трябва да създадете нова работна книга от съществуващата работна книга само с този лист в нея и след това да изпратите този лист.
| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849 | Функция SendActiveWorksheet (strTo As String, strSubject As String, Незадължително strCC As String, Незадължително strBody As String) Като BooleanПри грешка GoTo, а'декларират променливи, за да държат необходимите обектиDim wbDestination As WorkbookDim strDestName As StringDim wbSource As WorkbookЗатъмнете wsSource като работен листЗатъмнете OutApp като обектЗатъмнете OutMail като обектDim strTempName As StringDim strTempPath As String„първо създайте работна книга за местоназначениеЗадайте wbDestination = Workbooks.AddstrDestName = wbDestination.Name'задайте изходната работна книга и листЗадайте wbSource = ActiveWorkbookЗадайте wsSource = wbSource.ActiveSheet'копирайте активния лист в новата работна книгаwsSource.Copy After: = Работни книги (strDestName). Листове (1)'запишете с име на tempstrTempPath = Environ $ ("temp") & "\"strTempName = "Списък, получен от" & wbSource.Name & ".xlsx"С wbDestination.SaveAs strTempPath & strTempName'сега изпратете имейл на работната книга на местоназначениетоЗадайте OutApp = CreateObject ("Outlook.Application")Задаване на OutMail = OutApp.CreateItem (0)С OutMail.To = strTo.Subject = strSubject.Body = strBody.Допълнения. Добавете wbDestination.FullName'използвайте изпращане за незабавно изпращане или показване за показване на екрана.Display 'или .DisplayКрай с.Затвори FalseКрай с„изтрийте временна работна книга, която сте прикачили към пощата сиУбийте strTempPath & strTempName„почистете обектите, за да освободите паметтаЗадайте wbDestination = НищоЗадайте wbSource = НищоЗадайте wsSource = НищоЗадайте OutMail = НищоЗадайте OutApp = НищоИзлезте от функциятаа:MsgBox Err. ОписаниеКрайна функция |
и за да стартираме тази функция, можем да създадем следната процедура
| 12345678910111213 | Sub SendSheetMail ()Dim strTo As StringDim strSubject As StringDim strBody As StringstrTo = "[email protected]"strSubject = "Моля, намерете прикачен финансов файл"strBody = "тук има текст за тялото на имейла"Ако SendActiveWorksheet (strTo, strSubject,, strBody) = Вярно, тогаваMsgBox „Успех при създаването на имейл“ИначеMsgBox "Създаването на имейл не бе успешно!"Край АкоEnd Sub |
