Question

我单独创建了一个查询，现在想要使用VBA读取其记录，然后在电子邮件中发送所有行的某些字段。

我目前仍在尝试从记录集中提取所有行。我知道如何为一条记录执行此操作，但不知道如何使用动态记录集。每周，记录集可能有1-10（大约）记录。我希望通过动态读取所有行，将我想要的字段保存到变量中，然后将其添加到电子邮件正文中来实现此目的，但是我遇到了错误。

我收到的错误是：Run-time error '3265': Item not found in this collection.

有谁知道如何修复此错误以及如何将记录集的所有结果行放入电子邮件正文中？

代码：

Private Sub Form_Timer()

    'current_date variable instantiated in a module elsewhere
    current_date = Date

    'Using the Date function to run every Monday, regardless of the time of day
    If current_date = (Date - (DatePart("w", Date, 2, 1) - 1)) Then

        'MsgBox ("the current_date variable holds: " & current_date)

        Dim dbs As DAO.Database
        Dim rst As DAO.Recordset
        Dim qdf As DAO.QueryDef
        Dim prm As DAO.Parameter
        Dim varRecords As Variant
        Dim intNumReturned As Integer
        Dim intNumColumns As Integer
        Dim intColumn As Integer
        Dim intRow As Integer
        Dim strSQL As String
        Dim rst_jobnumber As String
        Dim rst_bfloc As String

        Set dbs = CurrentDb
        Set qdf = dbs.QueryDefs("qry_BMBFLoc")
        Set rst = qdf.OpenRecordset

        If rst.EOF Then

            MsgBox "Null."

        Else

            'Found this part of the code online and not sure if I'm using it right.
            varRecords = rst!GetRows(3)
            intNumReturned = UBound(varRecords, 2) + 1
            intNumColumns = UBound(varRecords, 1) + 1

            For intRow = 0 To intNumReturned - 1
              For intColumn = 0 To intNumColumns - 1
                 Debug.Print varRecords(intColumn, intRow)
              Next intColumn
            Next intRow
            'End of code found online.

            'rst.MoveFirst 'commenting this out because this query could potentially return multiple rows
            rst_jobnumber = rst!job & "-" & rst!suffix
            rst_bfloc = rst!Uf_BackflushLoc

            rst.Close
            dbs.Close

            Set rst = Nothing
            Set dbs = Nothing

            'Dim oApp As Outlook.Application
            'Dim oMail As MailItem

            'Set oApp = CreateObject("Outlook.application")

            'mail_body = "The following jobs do not have the special BF location set in Job Orders: " & rst_

            'Set oMail = oApp.CreateItem(olMailItem)
            'oMail.Body = mail_body
            'oMail.Subject = "Blow Molding Jobs Missing BF Location"
            'oMail.To = "something@something.com" 'in the future, create a function that finds all of the SC users' emails from their Windows user
            'oMail.Send

            'Set oMail = Nothing
            'Set oApp = Nothing

        End If

    End If

ErrorHandler:
    MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description

End Sub

Answer 1

尝试使用此代码，看看它是如何工作的。我不确定你是否每发送一封电子邮件或一封电子邮件（我假设后者）

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strMessageBody As String

Set dbs = CurrentDb
Set rst = CurrentDb.OpenRecordset("qry_BMBFLoc")

strMessageBody = "The following jobs do not have the special BF location set in Job Orders: "

If Not (rst.EOF And rst.BOF) Then
    rst.MoveFirst
    Do Until rst.EOF = True           
          strMessageBody = strMessageBody & rst!job & "-" & rst!suffix & ","
    rst.MoveNext
    Loop

  If Right(strMessageBody, 1) = "," Then strMessageBody = Left(strMessageBody, Len(strMessageBody)-1)
  End If
  rst.Close

Set rst = Nothing
Set dbs = Nothing

Answer 2

编辑 - 不使用点运算符

替换

varRecords = rst!GetRows(3)

与

varRecords = rst.GetRows(3)

记录集中有三行吗？

如果不是rst!GetRows(3)将返回false - 当您尝试使用UBound时，下一行将失败。

A good example of how to implement GetRows

另一种可能性是，如果您尝试在rst!

的行上访问不在记录集中的字段

尝试读取记录集的所有行时出错

2 个答案: