问题描述
这是我根据@Parfait 建议更新的代码。它仍然无法正常工作，出现以下错误：
在下面一行：Set rec = qdef.OpenRecordset(strQry)
Option Compare Database
Private Sub Command0_Click()
Dim db As DAO.Database
Dim qdef As DAO.QueryDef
Dim rec As DAO.Recordset
Dim olApp As Object
Dim olItem As Variant
Dim strQry As String
Dim aHead(1 To 4) As String
Dim aRow(1 To 4) As String
Dim aBody() As String
Dim lCnt As Long
'Prepared Statement No Data
strQry = "ParaMETERS cboParam TEXT(255);" _
& " SELECT [Loan ID],[Prior Loan ID],[SRP Rate],[SRP Amount] " _
& " FROM emailtable " _
& " WHERE [Seller Name:Refer to As] = [cboParam]"
Set db = CurrentDb
Set qdef = db.createqueryDef("",strQry)
' BIND ParaMETER
qdef!cboParam = Me.Combo296
' OPEN RECORDSET
Set rec = qdef.OpenRecordset(strQry)
'Create the header row
aHead(1) = "Loan ID"
aHead(2) = "Prior Loan ID"
aHead(3) = "SRP Rate"
aHead(4) = "SRP Amount"
lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "<HTML><body><table border='2'><tr><th>" & Join(aHead,"</th><th>") & "</th></tr>"
If Not (rec.BOF And rec.EOF) Then
do while Not rec.EOF
lCnt = lCnt + 1
ReDim Preserve aBody(1 To lCnt)
aRow(1) = rec("[Loan ID]")
aRow(2) = rec("[Prior Loan ID]")
aRow(3) = rec("[SRP Rate]")
aRow(4) = rec("[SRP Amount]")
aBody(lCnt) = "<tr><td>" & Join(aRow,"</td><td>") & "</td></tr>"
rec.MoveNext
Loop
End If
aBody(lCnt) = aBody(lCnt) & "</table></body></html>"
Set objOutlook = CreateObject("outlook.application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.display 'To display message
.To = Me.Combo88
.cc = Me.Combo282
.Subject = "*SECURE* " & Me.Combo296 & " refund Request (" & Me.Combo212 & " " & Me.Combo284 & ")"
.HTMLBody = "<p><font face=""calibri"" style=""font-size:11pt;"">Greetings,</p>" _
& "<p>We recently acquired loans from " & Me.Combo296 & ",some of which have paid in full and meet the criteria for early prepayment defined in the governing documents. We are requesting a refund of the SRP amount detailed on the attached list.</p>" _
& "<p>Please wire funds to the following instructions:</p>" _
& "<ul>Bank Name: My Bank</ul>" _
& "<ul>ABA: 1111111</ul>" _
& "<ul>Credit To: ABC Mortgage</ul>" _
& "<ul>Acct: 11111111111</ul>" _
& "<ul>Description: " & Combo296 & " EPO SRP refund</ul>" _
& "<p>Thank you for the opportunity to service loans from " & Me.Combo296 & "! We appreciate your partnership.</p>" _
& "<p>If you have any questions,please contact your Relationship Manager," & Me.Combo336 & " (Cc'd).</p>" _
& "<p><br>Sincerely,</br>" _
& "<br>Acquisitions</br>" _
& "<br>acquisitions@us.com</br></p>"
End With
rec.Close
Set rec = nothing: Set qdef = nothing: Set db = nothing
End Sub
任何帮助将不胜感激。
解决方法
避免将 VBA 数据连接到 SQL 甚至 HTML 字符串。相反，请考虑 SQL parameterization 的行业标准。
Dim db DAO.Database,qdef As DAO.QueryDef,rec AS DAO.Recordset
' PREPARED STATEMENT (NO DATA)
strQry = "PARAMETERS cboParam TEXT(255);" _
& " SELECT [Loan ID],[Prior Loan ID],[SRP Rate],[SRP Amount] " _
& " FROM emailtable " _
& " WHERE [Seller Name:Refer to As] = [cboParam]"
Set db = CurrentDb
Set qdef = db.CreateQueryDef("",strQry)
' BIND PARAMETER
qdef!cboParam = Me.Combo296
' OPEN RECORDSET
Set rec = qdef.OpenRecordset()
... ' REST OF CODE USING rec
rec.Close
Set rec = Nothing: Set qdef = Nothing: Set db = Nothing
此外，考虑将电子邮件 HTML 标记保存为表格中的文本或表单上的文本框，其中占位符将替换为组合框值：
.HTMLBody = Replace(Replace(Me.EmailMessage,"placeholder1",Me.Combo296),"placeholder2",Me.Combo336)
我猜（根据您的照片）您的 [Seller Name:Refer to as] 列的数据类型应该是 string？在这种情况下，您的查询缺少表示比较中字符串值的引号：
'Create each body row
strQry = "Select * from emailtable where [Seller Name:Refer to As] = """ & Me.Combo296 & """"
Set db = CurrentDb
Set rec = CurrentDb.OpenRecordset(strQry)