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

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 在 PC 上发送电子邮件的工作示例，可以轻松地根据您的需要进行调整：

如果需要 SSL，它会变得有点复杂。有关详细信息，请参阅此站点，特别是 SSL 代码的 link 到 Github：https://www.makeuseof.com/tag/send-emails-excel-vba/

编辑

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

Answer 2

我知道这是个老问题。我这样做只是为了 VB 和 SO 的未来新手，他们可能会根据客户的想象需求遇到类似或相同的问题。

在 SO 备受尊敬的 VB 开发人员的帮助下，我粘贴了我的全部代码和代码的解决方案。同样的问题及其解决方案可以在下面给出的 link 中找到：

https://codereview.stackexchange.com/questions/219371/write-to-excel-from-sql-db-using-vba-script/219378#219378

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

How to e-mail the entire excel file through VBA script

excel

vba

excel-2010