将查询中的表导出到电子邮件 VBA
Posted
技术标签:
【中文标题】将查询中的表导出到电子邮件 VBA【英文标题】：Export Table in Query to email VBA 【发布时间】：2017-02-24 02:58:40 【问题描述】：我正在尝试使用 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
【问题讨论】：
qry_email 运行了吗？ @Fionnuala 对不起，我是使用 VBA 的新手，但我怎么知道 qry_email 实际正在运行。我用不同的方法编辑了原始帖子。该方法有效，但我不知道如何将 WHERE 部分添加到代码中。 【参考方案1】：在你的代码的某处，写一行
X = [Forms]![fmremail]![Text1]
在你的代码中放一个断点（希望你知道怎么做？）在那一行。当代码中断时，按 F8 键跳到下一行，然后在即时窗口中键入 ?X。或者您可以将鼠标悬停在断点所在的行上。关键是，你需要看看你的代码认为 [Forms]![fmremail]![Text1] 等于什么。如果它为空，则说明您的参考有问题。在这种情况下，您可能需要在其末尾添加“.Value”或“.Text”。
要检查的另一件事是您的 WOID 数据类型。如果是文本，则需要用单引号括起来。
strQry = "SELECT tblePMParts.[Part#], tblePMParts.PartDescription, tblePMParts.Qty, tblePMParts.Price " & _
"FROM tblePMParts " & _
"WHERE (((tblePMParts.WOID)='" & [Forms]![fmremail]![Text1] & "'));"
【讨论】：
我把它改成了特定的记录，效果很好。例如，这有效“WHERE tblePMParts.WOID= 907;” .拥有文本框我没有尝试添加单引号，但它没有用。 Text1 是表单中的文本框。以上是关于将查询中的表导出到电子邮件 VBA的主要内容，如果未能解决你的问题，请参考以下文章
VBA 展望。尝试从电子邮件正文中提取特定数据并导出到 Excel
VBA Excel - 从 MS Access 将列名保存到电子表格