Acest tutorial vă va arăta cum să trimiteți e-mailuri din Excel prin Outlook folosind VBA.
Trimiterea registrului de lucru activ
| 1234567891011121314151617181920 | Funcție SendActiveWorkbook (strTo As String, strSubject As String, StrCC opțional Ca String, StrBody opțional Ca String) Ca BooleanLa eroare Reluați în continuareDim appOutlook As ObjectDim mItem Ca obiect'creați o nouă instanță a OutlookSetați appOutlook = CreateObject ("Outlook.Application")Setați mItem = appOutlook .CreateItem (0)Cu mItem.To = strTo.CC = "".Subject = strSubject.Body = strBody.Attachments.Add ActiveWorkbook.FullName'utilizați trimitere pentru a trimite imediat sau afișați pentru a afișa pe ecran.Display 'sau .SendSe termina cu'curăță obiecteSet mItem = NothingSet appOutlook = NimicFuncția de sfârșit |
Funcția de mai sus poate fi apelată folosind procedura de mai jos
| 123456789101112131415 | Sub SendMail ()Dim strTo As StringDim strSubject As StringDim strBody As String'populează variabilestrTo = "[email protected]"strSubject = "Vă rugăm să găsiți fișierul financiar atașat"strBody = "un text merge aici pentru corpul e-mailului"'apelați funcția pentru a trimite e-mailulDacă SendActiveWorkbook (strTo, strSubject,, strBody) = adevărat atunciMesaj "Succes la crearea e-mailului"AltfelMesaj "Nu s-a reușit crearea e-mailului!"Încheie dacăSfârșitul Sub |
Utilizarea legării timpurii pentru a face referire la biblioteca de obiecte Outlook
Codul de mai sus folosește Late Binding pentru a se referi la obiectul Outlook. Puteți adăuga o referință la Excel și puteți declara aplicația Outlook și Outlook Mail Item folosind Early Binding, dacă este preferat. Early Binding face ca codul să ruleze mai repede, dar vă limitează, deoarece utilizatorul ar trebui să aibă aceeași versiune de Microsoft Office pe computerul său.
Faceți clic pe meniul Instrumente și Referințe pentru a afișa caseta de dialog referință.
Adăugați o referință la Biblioteca de obiecte Microsoft Outlook pentru versiunea de Office pe care o utilizați.
Apoi puteți modifica codul pentru a utiliza direct aceste referințe.
Un mare avantaj al legării timpurii este listele derulante care vă arată obiectele disponibile pentru utilizare!
Trimiterea unei singure foi din registrul de lucru activ
Pentru a trimite o singură foaie, trebuie mai întâi să creați un nou registru de lucru din registrul de lucru existent, cu doar acea foaie, apoi să trimiteți acea foaie.
| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849 | Funcția SendActiveWorksheet (strTo As String, strSubject As String, Optional strCC As String, Optional strBody As String) As BooleanOn Error GoTo eh'declarați variabile pentru a ține obiectele necesareDim wbDestination As WorkbookDim strDestName Ca șirDim wbSource As WorkbookDim wsSource Ca foaie de lucruDim OutApp Ca obiectReduceți mesajul ca obiectDim strTempName Ca șirDim strTempPath As String„creați mai întâi un registru de lucru de destinațieSetați wbDestination = Workbooks.AddstrDestName = wbDestination.Name'setați registrul de lucru sursă și foaiaSetați wbSource = ActiveWorkbookSetați wsSource = wbSource.ActiveSheet'copiați foaia de activități în noul registru de lucruwsSource.Copy After: = Workbooks (strDestName) .Sheets (1)'salvați cu un nume temporarstrTempPath = Environ $ ("temp") & "\"strTempName = "Listă obținută din" & wbSource.Name & ".xlsx"Cu wbDestination.SaveAs strTempPath & strTempName'acum trimiteți prin e-mail registrul de lucru de destinațieSet OutApp = CreateObject („Outlook.Application”)Set OutMail = OutApp.CreateItem (0)Cu OutMail.To = strTo.Subject = strSubject.Body = strBody.Attachments.Add wbDestination.FullName'utilizați trimitere pentru a trimite imediat sau afișați pentru a afișa pe ecran.Display 'sau .DisplaySe termina cu.Închide FalsSe termina cu'ștergeți registrul de lucru temporar pe care l-ați atașat la e-mailOmoară strTempPath & strTempName'curățați obiectele pentru a elibera memoriaSet wbDestination = NimicSet wbSource = NimicSet wsSource = NimicSet OutMail = NimicSet OutApp = NimicFuncția de ieșireeh:MsgBox Err. DescriereFuncția de sfârșit |
și pentru a rula această funcție, putem crea următoarea procedură
| 12345678910111213 | Sub SendSheetMail ()Dim strTo As StringDim strSubject As StringDim strBody As StringstrTo = "[email protected]"strSubject = "Vă rugăm să găsiți fișierul financiar atașat"strBody = "un text merge aici pentru corpul e-mailului"Dacă SendActiveWorksheet (strTo, strSubject,, strBody) = True ThenMsgBox „Creare e-mail reușită”AltfelMsgBox "Crearea e-mailului a eșuat!"End IfSfârșitul Sub |
