我目前正在开发一个电子表格,从几个不同的数据库中提取信息,但我遇到了一个问题。
我有一个数组,其中包含基于公司的仓库信息。仓库阵列搜索访问数据库以查找与每个仓库的交货相关的订单,但是,我们在数据库中有从未订单的仓库,这些仓库导致一切都崩溃,我假设因为它返回null,但是试图绕过null会导致不同的崩溃或相同的错误(运行时错误' 3021':应用程序定义或对象定义的错误)
Dim CnctVastInv As String
Dim CnVastInv As New ADODB.Connection
Dim RsVastInv As New ADODB.Recordset
Dim WHCatch As String
Dim x As Long, WHInc As Long
Dim ColorProg As Long
Dim TFSwtch As Boolean
''' Connect to the database to retrieve the invoices.
CnctVastInv = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Persist Security Info=False;Data Source=" & ThisWorkbook.Path & "\ESTrading.mdb;Jet OLEDB:Database Password = SAMvast99"
CnVastInv.Open ConnectionString:=CnctVastInv
WHInc = 3
TFSwtch = True
For i = LBound(Warehouses) To UBound(Warehouses)
WHCatch = Warehouses(i)
Debug.Print Warehouses(i)
sqlstr = "SELECT tblOEInvoiceHistory.ShipCode, tblOEInvoiceHistory.SalesOrder, tblOEInvoiceFooterHistory.ProdCode, tblOEInvoiceHistory.OrderDate " & _
"FROM tblOEInvoiceHistory " & _
"INNER JOIN tblOEInvoiceFooterHistory ON (tblOEInvoiceHistory.SalesOrder = tblOEInvoiceFooterHistory.SalesOrder) AND (tblOEInvoiceHistory.Invoice = tblOEInvoiceFooterHistory.Invoice) " & _
"WHERE (((tblOEInvoiceHistory.ShipCode) = " & Chr(34) & WHCatch & Chr(34) & "))" & _
"ORDER BY tblOEInvoiceHistory.OrderDate DESC"
RsVastInv.Open sqlstr, CnVastInv, adOpenDynamic, adLockReadOnly
''' Problem: Program crashes here if a Warehouse has never ordered something.
x = 1
Do Until ws.Cells(x, 1) = "END"
RsVastInv.MoveFirst
Do While Not RsVastInv.EOF
If TFSwtch = True Then
ColorProg = RGB(255, 225, 0)
Else
ColorProg = RGB(0, 210, 225)
End If
If RsVastInv.Fields("ProdCode").Value = ws.Cells(x, 1) Then
ws.Cells(x, WHInc) = RsVastInv.Fields("OrderDate")
Select Case ws.Cells(x, WHInc).Value
Case (Date - 365) To Date
ws.Cells(x, WHInc + 1) = "X"
ws.Cells(x, WHInc + 1).Font.Color = vbBlack
ws.Cells(x, WHInc) = ""
ws.Cells(x, WHInc).Interior.Color = ColorProg
Case (Date - 730) To (Date - 365)
ws.Cells(x, WHInc + 2) = ws.Cells(x, WHInc).Value
ws.Cells(x, WHInc + 2).Font.Color = vbBlack
ws.Cells(x, WHInc) = ""
ws.Cells(x, WHInc).Interior.Color = ColorProg
Case Is < (Date - 730)
'ws.Cells(x, WHInc + 2) = ws.Cells(x, WHInc).Value
ws.Cells(x, WHInc) = ""
ws.Cells(x, WHInc).Interior.Color = ColorProg
End Select
Exit Do
End If
RsVastInv.MoveNext
Loop
x = x + 1
Loop
WHInc = WHInc + 3
If Not UBound(Warehouses) Then
Select Case TFSwtch
Case Is = True
TFSwtch = False
Case Is = False
TFSwtch = True
End Select
End If
RsVastInv.Close
Next i
答案 0 :(得分:0)
修复的最终编辑,应该考虑到这一点,但检查BOF和EOF是否同时为真是清除了获取空数据库条目的问题。
x = 2
Do Until ws.Cells(x, 1) = "END"
If RsVastInv.BOF And RsVastInv.EOF Then Exit Do
RsVastInv.MoveFirst
Do While Not RsVastInv.EOF