访问VBA。 检测logging集条目是否会导致溢出
我有以下代码，我遍历查询生成的logging集，有时，查询中的几行将返回（0/0）。 当循环遍历logging集写出excel时，如果查询中的行确实返回（0/0），则在尝试访问它时会收到溢出错误。 我想抓住这个溢出错误，并将string“0％”分配给我的variables，而不是溢出值。 有谁知道一个方法来捕捉，并解决这些溢出错误？
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来捕获溢出错误，并将新的值赋给我的tempStringvariables，但是这并没有起作用，即使这样做，我实现它的方式将是麻烦的。
如果你不知道使用范围对象的方法CopyFromRecordset检查出来。 如果你的logging集只包含你想转储到excel的列，你可以大量简化你的代码。
eg xlSheet.Range("BA"&1).CopyFromRecordset rstAnswer
这里使用ADOlogging集，但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