如何通过VBA脚本通过电子邮件发送整个Excel文件

Question

我希望自动发送我的excel文件的电子邮件，这是我手动执行的

我有以下流程结构：任务调度程序 - > .bat文件 - > VBA脚本 - > excel公式

这意味着我的任务调度程序将命中.bat文件，该文件将触发VB文件执行代码，这将把数据从SQL DB转储到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 Application模块类似：

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/

然后在objWorkbook.save行下面的VB文件Macro1中添加：

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

如果您通过smtp服务器发送，它会变得稍微复杂一些，因为您需要确保加载CDO库，这取决于邮件服务器的安全设置。这个主题提供了VBA在PC上发送电子邮件的工作示例，可以轻松地根据您的需求进行调整：Send email with workbook from VBA macro on both Windows and Mac

如果需要SSL，则会更复杂一些。有关更多详细信息，请参阅此站点，特别是有关SSL代码的Github链接：https://www.makeuseof.com/tag/send-emails-excel-vba/

编辑

我完全同意之前的评论，这不是完成报告SQL数据的最佳方法。这可以是一个快速解决方案，但使用SSRS发送这些报告应该是您的主要关注点。我希望这不是关键任务数据，否则如果您在无人看管时出现错误，则不会收到电子邮件。