Question

我正在尝试使用表格格式的VBA将我的一个查询导出到电子邮件。与您转到外部数据并单击和发送电子邮件类似，它会为Outlook添加附件。除了我想要它在体内。我将以下代码放在一个按钮中。

我发现并对某些代码进行了一些更改。这就是我所拥有的。

Private Sub Command5_Click()
Dim olApp As Object
Dim olItem As Variant
Dim db As DAO.Database
Dim rec As DAO.Recordset
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

'Create the header row
aHead(1) = "Part"
aHead(2) = "Description"
aHead(3) = "Qty"
aHead(4) = "Price"

lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th>    <th>") & "</th></tr>"

'Create each body row
strQry = "SELECT * From qry_email"
Set db = CurrentDb
Set rec = CurrentDb.OpenRecordset(strQry)

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("Part")
    aRow(2) = rec("Description")
    aRow(3) = rec("Qty")
    aRow(4) = rec("Price")
    aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
    rec.MoveNext
Loop
End If

aBody(lCnt) = aBody(lCnt) & "</table></body></html>"

'create the email
Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(0)

olItem.Display
olItem.To = "email@email.com"
olItem.Subject = "Test E-mail"
olItem.HTMLBody = Join(aBody, vbNewLine)
olItem.Display

End Sub

当我运行代码时，我得到一个“运行时错误'3061'参数太少。预计为1.”

如果我点击调试，我会以黄色突出显示。任何人的帮助将不胜感激！

修改

我尝试了一种不同的方法，它实际上给了我电子邮件正文中的列表。但它是为整个表而不仅仅是我想要的一个记录。这就是SQL的查询结果。

SELECT tblePMParts.[Part#], tblePMParts.PartDescription, tblePMParts.Qty,      tblePMParts.Price
FROM tblePMParts
WHERE (((tblePMParts.WOID)=[Forms]![fmremail]![Text1]));

我如何将WHERE添加到下面的代码中。

Private Sub Command4_Click()


'On Error GoTo Errorhandler

Dim olApp As Object
Dim olItem As Variant
Dim olatt As String
Dim olMailTem As Variant
Dim strSendTo As String
Dim strMsg As String
Dim strTo As String
Dim strcc As String
Dim rst As DAO.Recordset
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim qry As DAO.QueryDef
Dim fld As Field
Dim varItem As Variant
Dim strtable As String
Dim rec As DAO.Recordset
Dim strQry As String




strQry = "SELECT tblePMParts.[Part#], tblePMParts.PartDescription,  tblePMParts.Qty, tblePMParts.Price  " & _
         "FROM tblePMParts; "

strSendTo = "test@email.com"

strTo = ""
strcc = ""

Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(olMailTem)

olItem.Display
olItem.To = strTo
olItem.CC = strcc
olItem.Body = ""
olItem.Subject = "Please Quote the Following!"

Set db = CurrentDb
Set rec = CurrentDb.OpenRecordset(strQry)
If Not (rec.BOF And rec.EOF) Then
    rec.MoveLast
    rec.MoveFirst
    intCount = rec.RecordCount
        For intLoop = 1 To intCount
            olItem.Body = olItem.Body & rec("[Part#]") & " - " &     rec("PartDescription") & " - " & rec("Qty") & " - " & rec("Price")
            rec.MoveNext
        Next intLoop
End If

MsgBox "Completed Export"
Set olApp = Nothing
Set olItem = Nothing

Exit_Command21_Click:
Exit Sub
ErrorHandler:
MsgBox Err.Description, , Err.Number
Resume Exit_Command21_Click

End Sub

我得到了它的工作。这是代码，以防任何人需要它。

Private Sub Command5_Click()
Dim olApp As Object
Dim olItem As Variant
Dim db As DAO.Database
Dim rec As DAO.Recordset
Dim strQry As String
Dim aHead(1 To 3) As String
Dim aRow(1 To 3) As String
Dim aBody() As String
Dim lCnt As Long

'Create the header row
aHead(1) = "Part#"
aHead(2) = "Description"
aHead(3) = "Qty"

lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"

'Create each body row
strQry = "SELECT tblePMParts.[Part#], tblePMParts.PartDescription,  tblePMParts.Qty, tblePMParts.Price  " & _
 "FROM tblePMParts " & _
 "WHERE (((tblePMParts.WOID)=" & [Forms]![fmremail]![Text1] & "));"
Set db = CurrentDb
Set rec = CurrentDb.OpenRecordset(strQry)

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("[Part#]")
        aRow(2) = rec("PartDescription")
        aRow(3) = rec("Qty")
        aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
        rec.MoveNext
    Loop
End If

aBody(lCnt) = aBody(lCnt) & "</table></body></html>"

'create the email
Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(0)

olItem.Display
olItem.To = "Email"
olItem.Subject = "Test E-mail"
olItem.HTMLBody = Join(aBody, vbNewLine)
olItem.Display

End Sub

Answer 1

在代码中的某处，添加一行

X = [Forms]![fmremail]![Text1]

在你的代码中放一个断点（希望你知道怎么做？）。代码断开时，按F8键跳到下一行，然后在立即窗口中键入？X.或者您可以将鼠标悬停在具有断点的线上。关键是，你需要看看你的代码认为[Forms]！[fmremail]！[Text1]等于。如果它为null，则表示您的引用存在问题。在这种情况下，您可能需要在其末尾添加“.Value”或“.Text”。

要检查的另一件事是您的WOID数据类型。如果是文字，你需要用单引号括起来。

strQry = "SELECT tblePMParts.[Part#], tblePMParts.PartDescription,  tblePMParts.Qty, tblePMParts.Price  " & _
     "FROM tblePMParts " & _
     "WHERE (((tblePMParts.WOID)='" & [Forms]![fmremail]![Text1] & "'));"

Answer 2

我要将这个优秀的答案链接到你：https://stackoverflow.com/a/8450437/3689364

＆＃34;运行时错误＆＃39; 3061＆＃39;。参数太少。预计1。＆＃34;

我相信当你的sql查询中的字段名称没有时会发生这种情况   匹配表字段名称，即查询中的字段名称是错误的   或者表格完全没有这个字段。

您的记录集查询必定是错误的。在SQL编辑器中尝试使用所有参数替换实际值。如果错误再次发生，则访问将突出显示查询的错误部分。

将查询中的表导出为电子邮件VBA

2 个答案: