VBA Update SQL only updating field value to 0

[thechazm]

Hey folks,

I am running into something that really is kicking my butt for some reason...

When I try to run a simple update query written in VBA I get no errors but the field that I am trying to update just gets a 0 instead of the appropriate ID that I am passing. Any help on this is appreciated but here is the VBA.

Function ExtractProjects()
On Error GoTo ErrHandler:
Dim db As Database, rs As DAO.Recordset, rs2 As DAO.Recordset, var() As Variant, i As Long, qdf As DAO.QueryDef, ii As Long
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [ID], [SDSK] from [Project Name Ref] WHERE((([SDSK]) Is Not Null))", dbOpenSnapshot)
rs.MoveLast
rs.MoveFirst
ReDim var(rs.RecordCount, 2)
i = 0
Do While rs.EOF = False
    var(i, 0) = rs("SDSK")
    var(i, 1) = rs("ID")
    i = i + 1
    rs.MoveNext
Loop
rs.Close
For i = LBound(var) To UBound(var)
    StatusLabel "Find Project Reference for ST and OT Charges. On Project: " & var(i, 0)
 
    ii = var(i, 1)
 
    db.Execute "UPDATE [(SDSK) Charges Master] SET [(SDSK) Charges Master].PID = " & ii & _
    " WHERE ((([(SDSK) Charges Master].[IBB Date]) Between #" & GetChargesStart & "# And #" & GetChargesEnd & "#) AND " & _
    "(([(SDSK) Charges Master].[Charge Num]) Like '*" & var(i, 0) & "*' And ([(SDSK) Charges Master].[Charge Num]) Is Not Null));", dbFailOnError
 
  Next i
StatusLabel "Completed!"
Set qdf = Nothing
Set db = Nothing
Exit Function
ErrHandler:
If Err.Number = 3052 Then
    StatusLabel "Clearing Buffer..."
    Err.Clear
    Resume
Else
    MsgBox Err.Number & " " & Err.Description
End If
Set qdf = Nothing
Set db = Nothing
End Function

The funny thing is if I run the query itself it works by using a parameter query but when I try and run it like this all I get is 0's in the field that it's supposed to be updating.

The field [(SDSK) Charges Master].PID properties are as followed and is a linked table:

Type: Integer
Indexed: Yes (Duplicates Allowed)

A debug.print of the results of the query trying to be ran is the follows:

UPDATE [(SDSK) Charges Master] SET [(SDSK) Charges Master].PID = 1 WHERE ((([(SDSK) Charges Master].[IBB Date]) Between #10/24/2014# And #11/19/2014#) AND (([(SDSK) Charges Master].[Charge Num]) Like '*BAA*' And ([(SDSK) Charges Master].[Charge Num]) Is Not Null));

As you can see it is providing a number to be set to but instead it just fills it in with a 0.

Folks thanks in advance for any and all help with this. Thank you!

 

[pbaldy]

For starters, I don't see the point of the array. Why not just execute the SQL within the recordset loop?

To the problem, the only thing I see right off wouldn't seem relevant, but let's start with it. I think you need delimiters around the text value:

... Like *BAA* And...

should be:

... Like '*BAA*' And...

Try changing that and see if it helps.

 

[thechazm]

Dang it was the array... The very last round even though I used

For i = LBound(var) To UBound(var)

It passed in a blank one that allowed it to reset all values to 0 lol figures

The worst part about this whole situation was that array was used in an old way I used to do years ago and never went back and changed it..

New code works:

Function ExtractProjects()
On Error GoTo ErrHandler:
Dim db As Database, rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [ID], [SDSK] from [Project Name Ref] WHERE((([SDSK]) Is Not Null))", dbOpenSnapshot)
Do While rs.EOF = False
    StatusLabel "Find Project Reference for ST and OT Charges. On Project: " & rs("SDSK")
    
    db.Execute "UPDATE [(SDSK) Charges Master] SET [(SDSK) Charges Master].PID = " & rs("ID") & _
    " WHERE ((([(SDSK) Charges Master].[IBB Date]) Between #" & GetChargesStart & "# And #" & GetChargesEnd & "#) AND " & _
    "(([(SDSK) Charges Master].[Charge Num]) Like '*" & rs("SDSK") & "*' And ([(SDSK) Charges Master].[Charge Num]) Is Not Null));", dbFailOnError
    
    rs.MoveNext
Loop
rs.Close
StatusLabel "Completed!"
Set rs = Nothing
Set db = Nothing
Exit Function
ErrHandler:
If Err.Number = 3052 Then
    StatusLabel "Clearing Buffer..."
    Err.Clear
    Resume
Else
    MsgBox Err.Number & " " & Err.Description
End If
rs.Close
Set rs = Nothing
Set db = Nothing
End Function

Thanks for the help!

 

[pbaldy]

Happy to help, though I just nudged. You found the problem.

 

[thechazm]

Sometimes that's all you need Thanks buddy