Question : Using ADO instead of DAO

I have a sales application created in an earlier version of Access, that links SQL Server 2000 tables (i.e. It is the front end for a SQL Server 2000 back end). I recently upgraded to Access 2007. Now ther is a problem with some VBA code that has always been used to update inventory as each line item is entered in the order form. The code is as follows:

Function InvCountEnter(PartNo As String, Qty As Integer) As Integer
Dim WSP As DAO.Workspace
Dim TDB As DAO.Connection
Dim ProdGen As DAO.Recordset
Dim ProdInv As Long
Set WSP = DBEngine.CreateWorkspace("Main", "sa", "sysadm", dbUseODBC)
Set TDB = WSP.OpenConnection("SynergySQL")
Set ProdGen = TDB.OpenRecordset("Select * From SCGNMATL Where PartNo = '" & PartNo & "'", dbOpenDynamic, 0, dbOptimistic)

If ProdGen.EOF Then
Beep
MsgBox " Part not found", 48, "Invalid Data"
InvCountEnter = False
Else
ProdInv = ProdGen!PartReady
ProdInv = ProdInv - Qty
ProdGen.Edit
ProdGen!PartReady = ProdInv
ProdGen.Update
InvCountEnter = True
End If
ProdGen.Close
TDB.Close
End Function

Now when the code runs (the AfterUpdate event), I get the following error message:

Runtime error 3847
OBDCDirect is no longer supported. Rewrite the code to use ADO instead of DAO.

The debugger indicates that the code fails on the 6th line ("Set WSP =..."). It's pretty clear that the code needs to be revamped, but I'm not quite that accomplished yet and the guy who created it is long gone. Help would be appreciated.

Answer : Using ADO instead of DAO

I would move setting the values of and into the "truthy" portion of the function:

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

           
           
             Function InvCountEnter(PartNo As String, Qty As Integer) As Integer
    Dim ProdGen As ADODB.Recordset
    Dim sql As String
    Dim val As Long
    Set ProdGen = CurrentProject.Connection.Execute("Select * From SCGNMATL Where PartNo = '" & PartNo & "'")
       
    If ProdGen.EOF Then
        Beep
        MsgBox "    Part not found", 48, "Invalid Data"
        InvCountEnter = False
    Else
        val = ProdGen.Fields("PartReady").Value - Qty
        sql = "UPDATE SCGNMATL SET PartReady = " & val & " Where PartNo = '" & PartNo & "'"
        CurrentProject.Connection.Execute sql
        InvCountEnter = True
    End If
    ProdGen.Close
    Set ProdGen = Nothing
End Function
           
         

Open in New Window Select All