丢失数据库信息导致崩溃

时间:2014-10-24 21:08:41

标签: excel vba access-vba

我目前正在开发一个电子表格,从几个不同的数据库中提取信息,但我遇到了一个问题。

我有一个数组,其中包含基于公司的仓库信息。仓库阵列搜索访问数据库以查找与每个仓库的交货相关的订单,但是,我们在数据库中有从未订单的仓库,这些仓库导致一切都崩溃,我假设因为它返回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

1 个答案:

答案 0 :(得分:0)

抱歉,我是个白痴。当记录将EOF返回为True时,不能MoveFirst。

修复的最终编辑,应该考虑到这一点,但检查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