excel - 如何通过 VBscript 通过电子邮件发送整个 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 或私有(private) 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/

然后在 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 发送这些报告应该是您的主要关注点。我希望这不是关键任务数据，否则如果您在无人看管时遇到错误，则不会发送电子邮件。