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

Question

我有以下代码，在其中循环遍历查询生成的记录集，有时，查询中的几行会 return (0/0)。当遍历记录集以写出到 excel 时，如果查询中的行确实 return (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 变量，但这没有用，即使成功了，我实现它的方式也会很麻烦。

Answer 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

Answer 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

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

Access VBA. Detect if recordset entry will give overflow

excel

ms-access

vba

recordset