Как отправить по электронной почте весь файл Excel через скрипт VBA

Question

Я хочу автоматизировать отправку по электронной почте моего файла Excel, который в настоящее время выполняется мной вручную

У меня есть следующая структура потока: Планировщик задач -> .bat файл -> VBA-скрипт -> формулы Excel

Это означает, что мой планировщик заданий будет нажимать на файл .bat, который будет запускать файл VB для выполнения кода, и это будет выгружать данные из базы данных SQL в файл Excel, а затем формулы внутри файла Excel будут готовить диаграммы и графики и всерасчеты.

Вот мой код файла VB:

    Macro1
Private Sub Macro1()

Set objExcel  = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\kursekar\Documents\Work\Apps\ReferralStrApp\StdztnRefRepTrial.xlsx")
objExcel.Visible = False
Set Conn = CreateObject("ADODB.Connection")
Set RS   = CreateObject("ADODB.Recordset") 
Dim SQL
Dim Sconnect
Sconnect = "Provider=SQLOLEDB.1;Password='25LaurelRoad';User ID='CPSMDIT\kursekar';Data Source='analyzer';Initial Catalog='analyzer_str';Integrated Security=SSPI; Persist Security Info=True;"
Conn.Open Sconnect

SQL = "WITH cte_REFERRALS_REPORTS(referralnum, refer_from, refer_from_name, refer_from_id, refer_to, refer_to_name, refer_to_id) AS (SELECT referralnum, refer_from, CASE WHEN refer_from_id = 'R' THEN RdicF.refname WHEN refer_from_id = 'P' THEN PdicF.provname END AS refer_from_name, refer_from_id, refer_to, "
SQL = SQL & "CASE WHEN refer_to_id = 'R' THEN RdicT.refname WHEN refer_to_id = 'P' THEN PdicT.provname END AS refer_to_name, refer_to_id FROM referral_t r Left Join refcode_t RdicF ON  r.refer_from = CASE WHEN r.refer_from_id='R' THEN RdicF.refcode ELSE NULL END Left Join refcode_t RdicT ON  r.refer_to = CASE WHEN r.refer_to_id = 'R' THEN RdicT.refcode ELSE NULL END "
SQL = SQL & "Left Join provcode_t PdicF ON r.refer_from  = CASE WHEN r.refer_from_id = 'P' THEN PdicF.provcode ELSE NULL END Left Join provcode_t PdicT ON r.refer_to = CASE WHEN r.refer_to_id = 'P' THEN PdicT.provcode ELSE NULL END ) SELECT chgslipno , a.acctno, patfname, patlname, appt_date, a.enccode, pr.provname "
SQL = SQL & ",a.provcode, rfc.refname, a.refcode, r1.refer_from as r1_ref_from, r1.refer_from_id as r1_ref_from_id, r1.refer_from_name as r1_ref_from_name, a.referral1 as r1_refnum, r2.refer_from as r2_ref_from, r2.refer_from_id as r2_ref_from_id, r2.refer_from_name as r2_ref_from_name,a.referral2, prgrc.provgrpdesc,s.specdesc, a.prov_dept, pos.posdesc,pr.cred "
SQL = SQL & "FROM apptmt_t a Left JOIN patdemo_t p ON a.acctno = p.acctno LEFT JOIN provcode_t pr ON pr.provcode = a.provcode LEFT JOIN refcode_t rfc ON a.refcode = rfc.refcode LEFT JOIN (SELECT*FROM cte_REFERRALS_REPORTS) r1 ON a.referral1 = r1.referralnum LEFT JOIN (SELECT*FROM cte_REFERRALS_REPORTS) r2 "
SQL = SQL & "on a.referral2 = r2.referralnum LEFT JOIN provgrpprov_t prgrpr on a.provcode = prgrpr.provcode LEFT JOIN provgrpcode_t prgrc on prgrpr.provgrpcode = prgrc.provgrpcode LEFT JOIN specialty_t s on pr.speccode = s.speccode LEFT JOIN poscode_t pos on a.poscode = pos.poscode "
SQL = SQL & "WHERE UPPER(a.enccode) in ('CON','APE','COB','CONZ','HAC','HFUI','MMN','NCG','NCHF','NCPF','NHFU','NMC','NOB','NP','NP15','NPE','NPI','NPOV','NPS','NPSV','NPV','OVN','IMC','NP30') AND UPPER(a.appt_status)='ARR' AND appt_date >= '2017-01-01' "
SQL = SQL & "ORDER BY a.acctno"

Set Sheet = objWorkbook.ActiveSheet
Sheet.Activate

RS.Open SQL, Conn
 Sheet.Range("A2").CopyFromRecordset RS

RS.Close
Conn.Close

objExcel.DisplayAlerts = False
'Release memory
'Set objFSO = Nothing
'Set objFolder = Nothing
'Set objFile = Nothing
objWorkbook.Save
objExcel.DisplayAlerts = True
objWorkbook.Close
objExcel.Workbooks.Close
objExcel.Quit

'Set objExcel = Nothing
MsgBox ("Saved")
End Sub

Answer 1

Это сильно зависит от того, как вы хотите отправить электронное письмо. Вы используете Outlook или пытаетесь отправить его через Gmail, Yahoo или частный SMTP-сервер?

В любом случае, я бы добавил код vba для отправки файла в модуль файла excel. Файл bat вызывает Macro1 для обновления рабочей книги, а затем запускает код макроса внутри модуля в рабочей книге. Убедитесь, что код находится в модуле, а не на листах или в книге. Если вы используете outlook для электронной почты, код внутри модуля должен выглядеть примерно так с модулем приложения Outlook, загруженным в ссылки на библиотеку:

Sub Email_Active_Workbook()
'Working in Excel 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .to = "email@address"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add ActiveWorkbook.FullName
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Это адаптировано из: https://www.rondebruin.nl/win/s1/outlook/amail1.htm

На этот сайт также стоит ссылаться при отправке через outlook: https://wellsr.com/vba/2018/excel/vba-send-email-from-excel/

И это: https://powerspreadsheets.com/send-email-excel-vba/

А затем в вашем VB-файле Macro1 ниже строки objWorkbook.save добавьте:

objExcel.Application.Run "StdztnRefRepTrial.xlsx!Email_Active_Workbook"

Если вы отправляете через smtp-сервер, это немного усложняется, потому что вам нужно убедиться, что библиотека CDO загружена и зависит от настроек безопасности почтового сервера. В этой теме приведен рабочий пример отправки VBA электронной почты на ПК, которую можно легко адаптировать к вашим потребностям: Отправка электронной почты с рабочей книгой из макроса VBA как в Windows, так и в Mac

Если требуется SSL, он становится немного сложнее. Смотрите этот сайт для получения более подробной информации, в частности, ссылка на Github для кода SSL: https://www.makeuseof.com/tag/send-emails-excel-vba/

EDIT

Я полностью согласен с предыдущими комментариями, это не лучший способ сделать отчет по данным SQL. Это может быть быстрое решение, но использование SSRS для отправки этих отчетов должно быть вашим основным фокусом. Я надеюсь, что это не критически важные данные, в противном случае письма не будут отправлены, если вы оставите ошибку, оставив ее без присмотра.