You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.09.28 18:27:05