Fatal编程技术网
  • vba/
  • 访问VBA以将查询结果以表格格式发送到Outlook电子邮件

访问VBA以将查询结果以表格格式发送到Outlook电子邮件

vba ms-access outlook

访问VBA以将查询结果以表格格式发送到Outlook电子邮件,vba,ms-access,outlook,Vba,Ms Access,Outlook,我想根据我的表中的查询结果发送一封带有outlook的电子邮件，但要使用表格式（在正文中）。出于某种原因，代码只是将表中的最后一条记录输出到电子邮件正文，而不是循环并添加所有3条记录 有什么建议，或者更好的编码方法吗 Public Sub NewEmail() 'On Error GoTo Errorhandler Dim olApp As Object Dim olItem As Variant Dim olatt As String Dim olMailTe

我想根据我的表中的查询结果发送一封带有outlook的电子邮件，但要使用表格式（在正文中）。出于某种原因，代码只是将表中的最后一条记录输出到电子邮件正文，而不是循环并添加所有3条记录

有什么建议，或者更好的编码方法吗

Public Sub NewEmail()
'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 * From Email_Query"

    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 = "Test E-mail"

    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.HTMLBody = "<HTML><body>" & _
                "<table border='2'>" & _
                "<tr>" & _
                "<th> Request Type </th>" & _
                "<th> ID </th>" & _
                 "<th> Title </th>" & _
                  "<th> Requestor Name </th>" & _
                   "<th> Intended Audience </th>" & _
                   "<th> Date of Request</th>" & _
                   "<th> Date Needed </th>" & _
                   "</tr>" & _
                   "<tr>" & _
                      "<td>" & rec("Test1") & "</td>" & _
                      "<td>" & rec("Test2") & "</td>" & _
                      "<td>" & rec("Test3") & "</td>" & _
                      "<td>" & rec("Test4") & "</td>" & _
                      "<td>" & rec("Test5") & "</td>" & _
                      "<td>" & rec("Test6") & "</td>" & _
                      "<td>" & rec("Test7") & "</td>" & _
                      "</tr>" & _
                     "<body><HTML>"
                rec.MoveNext
            Next intLoop
    End If

    MsgBox "E-mail Sent"
    Set olApp = Nothing
    Set olItem = Nothing

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

Public Sub NewEmail（）
'关于错误转到Errorhandler
作为对象的Dim-olApp
作为变体的Dim
Dim olatt作为字符串
Dim olMailTem作为变体
将strSendTo设置为字符串
作为字符串的Dim strMsg
作为字符串的Dim strTo
作为字符串的Dim strc
将rst设置为DAO.Recordset
Dim rs作为DAO.Recordset
Dim数据库作为DAO.Database
将qry设置为DAO.QueryDef
Dim fld As字段
作为变体的Dim varItem
作为字符串的Dim strtable
作为DAO.Recordset的Dim rec
作为字符串的Dim strqry
strqry=“从电子邮件查询中选择*
strSendTo=”test@email.com"
strTo=“”
strc=“”
设置olApp=CreateObject（“Outlook.application”）
Set-olItem=olApp.CreateItem（olMailTem）
光电显示器
olItem.To=strTo
m.CC=strc
olItem.Body=“”
olItem.Subject=“测试电子邮件”
Set db=CurrentDb
Set rec=CurrentDb.OpenRecordset（strqry）
如果不是（rec.BOF和rec.EOF），则
移动记录
记录移动优先
intCount=rec.RecordCount
对于intLoop=1到intCount
olItem.HTMLBody=”“&_
"" & _
"" & _
“请求类型”和_
"ID"及_
"标题及_
“请求者名称”和_
“目标受众”和_
“请求日期”和_
“需要日期”和_
"" & _
"" & _
&rec（“Test1”）&_
&rec（“Test2”）&_
&rec（“Test3”）&_
&rec（“Test4”）&_
&rec（“Test5”）&_
&rec（“Test6”）&_
&rec（“Test7”）&_
"" & _
""
记录：下一个
下一个内循环
如果结束
MsgBox“已发送电子邮件”
设置olApp=Nothing
设置m=无
退出命令21\u单击：
出口接头
错误处理程序：
MsgBox错误描述，错误编号
继续退出命令21\u单击
端接头
您正在更改HTMLBody every循环，而不是添加到其中。您应该在循环上方设置标题行，然后在循环内部设置每一行。我喜欢填充数组并使用Join函数——这在视觉上更令人愉悦

Public Sub NewEmail()

    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 7) As String
    Dim aRow(1 To 7) As String
    Dim aBody() As String
    Dim lCnt As Long

    'Create the header row
    aHead(1) = "Request Type"
    aHead(2) = "ID"
    aHead(3) = "Title"
    aHead(4) = "Requestor Name"
    aHead(5) = "Intended Audience"
    aHead(6) = "Date of Request"
    aHead(7) = "Date Needed"

    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 Email_Query"
    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("Test1")
            aRow(2) = rec("Test2")
            aRow(3) = rec("Test3")
            aRow(4) = rec("Test4")
            aRow(5) = rec("Test5")
            aRow(6) = rec("Test6")
            aRow(7) = rec("Test7")
            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 = "example@example.com"
    olItem.Subject = "Test E-mail"
    olItem.htmlbody = Join(aBody, vbNewLine)
    olItem.display

End Sub

Public Sub NewEmail（）
作为对象的Dim-olApp
作为变体的Dim
Dim数据库作为DAO.Database
作为DAO.Recordset的Dim rec
作为字符串的Dim strQry
作为字符串提前变暗（1到7）
变暗箭头（1到7）为字符串
Dim aBody（）作为字符串
暗lCnt为长
'创建标题行
前置（1）=“请求类型”
前（2）=“ID”
前面（3）=“标题”
前（4）=“请求者名称”
前（5）=“预期观众”
提前（6）=“请求日期”
提前（7）=“需要日期”
lCnt=1
ReDim aBody（1至lCnt）
aBody（lCnt）=“加入（前进）”&“
'创建每个正文行
strQry=“从电子邮件查询中选择*
Set db=CurrentDb
Set rec=CurrentDb.OpenRecordset（strQry）
如果不是（rec.BOF和rec.EOF），则
不记录时执行
lCnt=lCnt+1
ReDim保存aBody（1至lCnt）
aRow（1）=记录（“测试1”）
aRow（2）=记录（“测试2”）
aRow（3）=记录（“测试3”）
aRow（4）=记录（“测试4”）
aRow（5）=记录（“测试5”）
aRow（6）=记录（“测试6”）
aRow（7）=记录（“测试7”）
aBody（lCnt）=“连接（aRow）”&”
记录：下一个
环
如果结束
aBody（lCnt）=aBody（lCnt）&“
'创建电子邮件
设置olApp=CreateObject（“Outlook.application”）
Set-olItem=olApp.CreateItem（0）
光电显示器
“m.To=”example@example.com"
olItem.Subject=“测试电子邮件”
olItem.htmlbody=Join（aBody，vbNewLine）
光电显示器
端接头