访问 VBA。检测记录集条目是不是会溢出

Posted 2023-05-07

【中文标题】访问 VBA。检测记录集条目是不是会溢出

【英文标题】：Access VBA. Detect if recordset entry will give overflow访问 VBA。检测记录集条目是否会溢出

【发布时间】：2015-08-12 13:33:45

【问题描述】：

我有以下代码循环通过查询生成的记录集，有时，查询中的几行将返回 (0/0)。当循环通过记录集写出到 excel 时，如果查询中的行确实返回 (0/0)，我在尝试访问它时收到溢出错误。我试图捕捉这个溢出错误，并将字符串“0%”分配给我的变量，而不是溢出值。有谁知道一种方法来捕捉和解决这些溢出错误？

Set qdf = CurrentDb.CreateQueryDef("Latest Estimate", sSQL)

            Set dbs = CurrentDb
            Set rstAnswer = dbs.OpenRecordset("Latest Estimate")

            If Not (rstAnswer.EOF And rstAnswer.BOF) Then
                rstAnswer.MoveFirst
                Do Until rstAnswer.EOF
                    tempString = CStr(rstAnswer!BU)
                    xlSheet.Range("BA" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer!Program)
                    xlSheet.Range("BB" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![EIS Date])
                    xlSheet.Range("BC" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![Part Count])
                    xlSheet.Range("BD" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![Current Actual Cost Index])
                    xlSheet.Range("BE" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![LTA Index ($)])
                    xlSheet.Range("BF" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![LTA Index (part count)])
                    xlSheet.Range("BG" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![LCB Index])
                    xlSheet.Range("BH" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![Drawings Released by Need Date])
                    xlSheet.Range("BI" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![Total Drawings released vs Needed])
                    xlSheet.Range("BJ" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![% Of Parts With Suppliers Selected])
                    xlSheet.Range("BK" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![% POs placed vs needed])
                    xlSheet.Range("BL" & CStr(tempRow)).Value = tempString
                    'tempString = CStr(rstAnswer![UPPAP Requirement])
                    xlSheet.Range("BM" & CStr(tempRow)).Value = tempString
                    tempString = CStr(rstAnswer![Number of parts identified for UPPAP])
                    xlSheet.Range("BN" & CStr(tempRow)).Value = tempString
                    rstAnswer.MoveNext
                    tempRow = tempRow + 1
                Loop

            Else
                MsgBox "There are no records in this recordset"
            End If
            programsAnswer.MoveNext
        Loop

我尝试使用 GoTo 捕获溢出错误并将新值分配给我的 tempString 变量，但这不起作用，即使它起作用了，我实现它的方式也会很麻烦。

【问题讨论】：

从记录集中读取字段时是否遇到错误？ tempString = CStr(rstAnswer!Program)

你试过 Str(rstAnswer!BU) 吗？

是的，特别是在可能生成 (0/0) 的行上。第一个这样做是[需要日期发布的图纸]

使用 Str(rstAnswer!BU) 给我一个类型不匹配错误

【参考方案1】：

如果您不知道在范围对象上使用 CopyFromRecordset 方法，请检查一下。如果您的记录集只包含您想转储到 excel 中的列，您可以大大简化您的代码。

eg xlSheet.Range("BA"&1).CopyFromRecordset  rstAnswer 

这里有一些使用 ADO 记录集的示例代码，但 DAO 也可以工作！

'
'Example of gathering data from an Access Application
' into excel (but similar for other apps)
'
Private Sub cmdGather_Click()

    'Define Variables
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlSheet As Object
    Dim oAdoConnect As Object
    Dim adoRecordset As ADODB.Recordset
    Dim lngColumn  As Long
    Dim strNewFile As String
    Dim strFilePath As String
    Dim strSQL As String

    'Always have a way to handle errors
    On Error GoTo Handler

    'Establish your ADO connection
    Set oAdoConnect = CreateObject("ADODB.Connection")
    oAdoConnect.Provider = "Microsoft.ACE.OLEDB.12.0"
    oAdoConnect.Open = Application.ActiveWorkbook.Path & "\Inventory.mdb"

    'Create the SQL statement
    strSQL = _
        "SELECT Customers.* " & _
        "FROM Customers " & _
        "WHERE (((Customers.ContactName) Like ""M*""));"

    'Create and open your recordset
    Set adoRecordset = CreateObject("ADODB.Recordset")
    adoRecordset.Open strSQL, oAdoConnect, adOpenStatic, adLockReadOnly

    'Create your Excel spreadsheet
    Set xlApp = Application
    Set xlWorkbook = xlApp.Workbooks.Add

    'Add the new Worksheet
    With xlWorkbook

        Set xlSheet = .Worksheets.Add
        xlSheet.Name = "Customers"

        ' Adds field names as column headers
        For lngColumn = 0 To adoRecordset.Fields.Count - 1
            xlSheet.Cells(1, lngColumn + 1).Value = adoRecordset.Fields(lngColumn).Name
        Next

        ' bold headers
        xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, adoRecordset.Fields.Count)).Font.Bold = True

        ' dump the data from the query
        xlSheet.Range("A2").CopyFromRecordset adoRecordset

    End With

    'Close the RecordSet
    adoRecordset.Close

    'Cleanup variables
    Set adoRecordset = Nothing
    Set oAdoConnect = Nothing
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
    Exit Sub

Handler:
    MsgBox _
        "An Error Occurred!" & vbNewLine & vbNewLine & _
        "Error Number: " & Err.Number & vbNewLine & vbNewLine & _
        "Error Message: " & vbNewLine & Err.Description & vbNewLine & vbNewLine & _
        "Error Source: " & Err.Source, vbOKOnly, "Error"
    Exit Sub
End Sub

【讨论】：

我会试试这个。在线 (oAdoConnect.Open = Application.ActiveWorkbook.Path & "\Inventory.mdb") 我将最后一部分设置为什么，“Inventory.mdb”字符串。我的访问数据库的名称？

@Dp 如果您不理解，请暂时忘记示例代码。只需将整个 if 语句及其包含的代码替换为 xlSheet.Range("BA1").CopyFromRecordset rstAnswer ，然后看看会发生什么。

【参考方案2】：

在投射之前检查值。

If rstAnswer.Fields("Drawings Released by Need Date").Value <> "0/0" Then
    tempString = CStr(rstAnswer!Drawings Released by Need Date)
Else
    tempString = "0%"
End If

【讨论】：

这看起来不错，但仍然给我一个溢出错误。只是试图读取该值显然会导致溢出。另外我不认为单元格中的值实际上是“0/0”，而是首先评估。我假设它里面有类似“#DIV/0”的东西，但我不知道有什么方法可以检查。

也许记录集中的任何内容都不需要强制转换。尝试更改 if 语句中的赋值。 tempString = rstAnswer.Fields("图纸发布日期").Value or tempString = str(rstAnswer.Fields("图纸发布日期").Value)

另外，您可以尝试将 Dim tempString 更改为 Variant

感谢马特的帮助，但我尝试摆脱 Cstr() 演员并使用变体，仍然给出相同的错误。

我们需要知道数据库的“Drawings Released by Need Date”字段中的内容。可能是 null 吗？