Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/24.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 访问VBA。检测记录集条目是否会导致溢出_Excel_Vba_Ms Access_Recordset - Fatal编程技术网

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

Excel 访问VBA。检测记录集条目是否会导致溢出,excel,vba,ms-access,recordset,Excel,Vba,Ms Access,Recordset,我有下面的代码,其中我循环通过一个查询生成的记录集,有时,查询中的几行将返回(0/0)。当循环通过记录集写入excel时,如果查询中的行确实返回(0/0),我在尝试访问它时会收到溢出错误。我试图捕获这个溢出错误,并将字符串“0%”分配给我的变量,而不是溢出值。有人知道如何捕捉并绕过这些溢出错误吗 Set qdf = CurrentDb.CreateQueryDef("Latest Estimate", sSQL) Set dbs = CurrentDb

我有下面的代码,其中我循环通过一个查询生成的记录集,有时,查询中的几行将返回(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变量,但这不起作用,即使起作用,我实现它的方式也会很麻烦。

如果您不知道在range对象上使用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

在强制转换之前检查该值

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
如果rstAnswer.字段(“按需要日期发布的图纸”)的值为“0/0”,则
tempString=CStr(按需要日期发布图纸)
其他的
tempString=“0%”
如果结束

从记录集中读取字段时是否出现错误?tempString=CStr(rstAnswer!程序)您是否尝试过Str(rstAnswer!BU)?是的,特别是在可能生成(0/0)结果的行上。第一个这样做的是使用Str(rstAnswer!BU)的[Drawings Released by Need Date]给我一个类型不匹配错误这看起来不错,但仍然给我一个溢出错误。仅尝试读取该值显然会导致溢出。此外,我认为单元格中的值不是字面上的“0/0”,而是首先计算的。我假设里面有“#DIV/0”之类的内容,但我不知道如何检查。也许记录集中的任何内容都不需要强制转换。尝试在if语句中更改赋值。tempString=rstAnswer.Fields(“按需要日期发布的图形”).Value或tempString=str(rstAnswer.Fields(“按需要日期发布的图形”).Value)同样,您可以尝试将Dim tempString更改为variant感谢Matt的帮助,但我尝试摆脱Cstr()强制转换并使用一个变量,仍然给出相同的错误。我们需要知道DB的“图纸发布日期”字段中有什么内容。可能是空的吗?我试试看。在第行(oAdoConnect.Open=Application.ActiveWorkbook.Path&“\Inventory.mdb”)上,我应该将最后一部分设置为“Inventory.mdb”字符串。我的access数据库的名称?@Dp如果您不理解示例代码,请暂时忘记它。只需将整个if语句及其包含的代码替换为
xlSheet.Range(“BA1”).CopyFromRecordset rstAnswer
,然后看看会发生什么。