VBS调用Access查询返回数据生成邮件时触发类型错误如何解决
VBS自动化邮件脚本类型错误排查
我有一个用于自动化流程的VBS脚本,每周会从数据库中拉取最新信息(最新数据已在数据库中预置查询逻辑),目前我已经编写了2个获取最新数据集的查询,以及生成邮件的函数,唯一的问题是返回数据数组的函数输出类型不符合预期,触发了类型错误。
代码实现
Class Email Private toccbcc Private ttl Private htmlb1,htmlb2,htmlb3 Private Sub Class_Initialize() toccbcc="aaaa@bbbb.com" htmlb1= "<html><body><p>" & _ "<table cellspacing=""0"" cellpadding=""0"" width=""630"" align=""left"" border=""0"" style=""border-collapse:collapse"">" & _ "<font size=""6""> <tr><td rowspan=""2"" style=""text-align:center; border:1px solid #000000; border-bottom:3px solid #000000;"" width=""105"">Type</td><td colspan=""2"" style=""text-align:center; border:1px solid #000000; border-bottom:line-height=1.8em, solid #000000;"" width=""105"">v2</td><td colspan=""2"" style=""text-align:center; border:1px solid #000000; border-bottom:line-height=1.8em solid #000000;"" width=""105"">v2</td></tr></font>" htmlb3="<br><br>Thank you,<br>Name</p></body></html>" ttl = DateValue(CStr(Now())) & " => " & DateValue(CStr(Now() + 6)) & " Type Pricing" htmlb2="" End Sub Private Sub Class_Terminate() End Sub Public Sub SetHTMLTableBody(tmp) For i=0 To UBound(tmp) If I = 0 Then htmlb2 = htmlb2 & "<font size=""4"">" End If For j=0 To UBound(tmp,2) If (TMP(I,J) <> "") Then If (I = 1) Then htmlb2 = htmlb2 & "<td style=""text-align:center; border:1px solid #000000; border-bottom:3px solid #000000;"" width=""105"">" Else htmlb2 = htmlb2 & "<td style=""text-align:center; border:1px solid #000000; border-bottom:line-height=1.8em"" width=""105"">" End If If (I = 0) Then htmlb2 = htmlb2 & "<b>" & TMP(I,J) & "</b>" Else htmlb2 = htmlb2 & TMP(I,J) End If htmlb2 = htmlb2 & "</td>" End If Next If I = 1 Then htmlb2 = htmlb2 & "</font>" End If htmlb2 = htmlb2 & "</tr>" Next End sub Public Property Get HTMLBODY() htmlbody=htmlb1&htmlb2&htmlb3 End Property Public Property Get ToCC() ToCC=toccbcc End Property Public Property Get Title() Title=ttl End property End Class Class Emailer Dim objoutlook Dim tmpmi Dim eml 'Dim WshShell Private Sub Class_Initialize() 'Set WshShell=WScript.CreateObject("WScript.shell") 'WshShell.Run "Outlook.exe" Set objoutlook=CreateObject("Outlook.application") WScript.Sleep 2000 End Sub Private Sub Class_Terminate() objoutlook.Quit Set objoutlook=Nothing Set eml=Nothing Set tmpmi=Nothing End Sub Public Property Set Email(em) Set eml=em End Property Public Sub SendEmail() Set tmpmi=objoutlook.CreateItem(0) With tmpmi .To=eml.ToCC() .Subject=eml.Title() .HTMLBody=eml.HTMLBODY() .ReadReceiptRequested = False .Send End with End Sub End Class Public Sub RunEmailer() Dim objaccess Dim objoutlook Dim WshShell 'Set WshShell=WScript.CreateObject("WScript.shell") 'WshShell.Run "Outlook.exe" 'WScript.Sleep 2000 Set objaccess=CreateObject("Access.Application") objaccess.Visible=False objaccess.OpenCurrentDatabase("...\SampleDatabase.accdb") Dim eml Dim emlr Set emlr=New emailer Set eml = New Email Set emlr.Email=eml eml.SetHTMLTableBody objaccess.Run("GetURV") WScript.Sleep 2000 objaccess.CloseCurrentDatabase objaccess.Quit Set objaccess=Nothing 'Set emlr.Email=eml 'emlr.SendEmail Set eml=Nothing Set emlr=Nothing End Sub RunEmailer()
问题描述
问题出在SetHTMLTableBody(tmp)中的tmp()参数,第一个可复现的错误出现在If (TMP(I,J) <> "") Then这一行,系统判定此处返回的内容属于无效数据类型。已尝试类型转换但没有效果,由于该数据最终要写入HTML邮件正文,需要将读取到的内容转换为字符串类型。
目前有可运行的版本,但效率很低,偶尔还会停止运行,当前流程如下图所示:
设计说明
选择通过VBS而非Access发送邮件的原因:Outlook是通过VBS关闭的而非Access,若脚本指示Outlook关闭时邮件还未发送完成,Outlook会弹出报错提示,同时这种方式还可以降低CPU占用(同一时间仅运行一个程序)。
选用Outlook的原因是邮件接收方和发送方在同一邮件服务器下。
内容的提问来源于stack exchange,提问作者cdickstein
相关产品推荐
相关产品推荐

