CODEWITHSUNDEEP
ms-accessvba
EnglischerZauberer
EnglischerZauberer

Reputation: 237

VBA DLookup in Loop

I've written a function to loop through an array of a custom object (C_Document). In the loop, if the document number does not already exist, it should insert a new record into the table tbl_docs. If the document does exist, it should update the appropriate record in the database.

Public Function updateDocuments(docs() As C_Document) As Double
Dim db As Object
Set db = Application.CurrentDb
Dim docIndex As Double

'Loop through all imported documents
For docIndex = 1 To UBound(docs)

    Dim strSQL As String

    Dim exists As Double
    exists = DCount("docNo", "tbl_docs", "docNo = '" & docs(docIndex).getDocNo() & "'" > 0)

    'Check if entry already exists
    If (exists > 0) Then
        'docNo entry already exists - update

         strSQL = "UPDATE tbl_docs SET " & _
                "docReviewStatus = " & docs(docIndex).getDocStatus() & "," & _
                "docRev = '" & docs(docIndex).getDocReview() & "'," & _
                "docDate = '" & docs(docIndex).getDocDate() & "'" & _
                " WHERE (" & _
                "docNo = '" & docs(docIndex).getDocNo() & "');"

    Else
        'docNo does not exist - insert

        strSQL = "INSERT INTO tbl_docs (docNo, docReviewStatus, docRev, docDate) " & _
                    "SELECT '" & docs(docIndex).getDocNo() & "'" & _
                    "," & docs(docIndex).getDocStatus() & _
                    ",'" & docs(docIndex).getDocReview() & "'" & _
                    ",'" & docs(docIndex).getDocDate() & "'" & _
                    ";"

    End If

    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True

    MsgBox strSQL

    Next

updateDocuments = docIndex

End Function

However, when the function is called (with tbl_docs empty), it only inserts one record and the SQL string thereafter becomes the update statement. enter image description here

enter image description here

Is there a common issue when DCount() is used in a loop? Does anyone have any experience with this logical error?

Upvotes: 0

Views: 360

Answers (2)

Gustav
Gustav

Reputation: 55841

You can simplify and speed up this a bit using DAO, where you can do the search and update/edit in one go:

Public Function updateDocuments(docs() As C_Document) As Long

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim docIndex As Long
    Dim strSQL As String

    strSQL = "Select * From tbl_docs"

    Set db = Application.CurrentDb
    Set rs = db.OpenRecordset(strSQL)

    'Loop through all imported documents
    For docIndex = LBound(docs) To UBound(docs)

        rs.FindFirst "docNo = '" & docs(docIndex).getDocNo() & "'"
        If rs.NoMatch Then
            'docNo does not exist - insert
            rs.AddNew
            rs!docNo.Value = docs(docIndex).getDocNo()
        Else
            'docNo entry already exists - update
            rs.Edit
        End If
        rs!docReviewStatus.Value = docs(docIndex).getDocStatus()
        rs!docRev.Value = docs(docIndex).getDocReview()
        rs!docDate = docs(docIndex).getDocDate()
        rs.Update

    Next
    rs.Close

    updateDocuments = docIndex

End Function

Upvotes: 2

Andre
Andre

Reputation: 27634

Your check has a slight but important error:

exists = DCount("docNo", "tbl_docs", "docNo = '" & docs(docIndex).getDocNo() & "'" > 0)

should be

exists = DCount("docNo", "tbl_docs", "docNo = '" & docs(docIndex).getDocNo() & "'") > 0

or if exists isn't bool, but simply the count, then 

exists = DCount("docNo", "tbl_docs", "docNo = '" & docs(docIndex).getDocNo() & "'")

Upvotes: 3

Related Questions