VBA works in orignal but fails in copy of database

[Derek Douglas]

I have a split database that I needed to move to a new location. I created a stand alone version by coping the forms, etc to a new table and then coping the "be: tables. Everything works except two areas. the first of which (VBA Below) is jumping to the ERR-FINSH sub. I jumped it out so I can get an idea of where the error is, and it presents a 2482 error referencing a table that DOES exist. I understand that the actual error might be earlier in the code but I can not figure out where. any help would be appreciated. the failure occurs as the code is running the second par in the QDFAPITM "with"

Private Sub Command86_Click() 'FINISH
'----------------------------------------------
' 8/12/09 Added modifications for Bill and Hold
'----------------------------------------------
Dim strSQL As String
Dim rst As DAO.Recordset
Dim strSQL1 As String

'On Error GoTo ERR_FINISH

Dim rstgo As DAO.Recordset
Set rstgo = CurrentDb.OpenRecordset("select * from [pl items a] where print = -1")
If rstgo.RecordCount = 0 Then
MsgBox "There are no items"
rstgo.CLOSE
Exit Sub
End If
rstgo.CLOSE


Dim WKS As DAO.Workspace
Dim DBCUR As DAO.Database
Dim QDFAPINV, QDFAPITM, QDFRSTPL, QDFRSTPI, QDFQTY, QDFPRT As DAO.QueryDef
Dim PAR As DAO.Parameter
Dim FTRAN As Boolean
Dim INVNO As Long

FTRAN = False
If IsNull(Me![INV NUMBER]) Or Me![INV NUMBER] = 0 Then 'GET RID OF THIS? WON'T BE ABLE TO CARRY PENDING INVOICES
DoCmd.OpenForm "FRM INV NUMBER", , , , , acHidden
INVNO = Forms![FRM INV NUMBER]![INV NO]
Forms![FRM INV NUMBER]![INV NO] = INVNO + 1
DoCmd.CLOSE acForm, "FRM INV NUMBER"
Me![INV NUMBER] = INVNO
Else
INVNO = Me![INV NUMBER]
End If
DoCmd.RunCommand acCmdSaveRecord


Set WKS = DBEngine.Workspaces(0)
Set DBCUR = WKS.Databases(0)
Set QDFAPINV = DBCUR.QueryDefs("APP PL INV")
Set QDFAPITM = DBCUR.QueryDefs("APP PL ITEMS")
Set QDFRSTPL = DBCUR.QueryDefs("RESET PL") 'HAVE TO KEEP THIS
Set QDFRSTPI = DBCUR.CreateQueryDef("", "DELETE * FROM [PL ITEMS A] WHERE HOLDER = " & Me![HOLDER] & "AND PRINT = -1")


WKS.BeginTrans
FTRAN = True
With QDFAPINV
For Each PAR In .Parameters
PAR.Value = Eval(PAR.name)
Next PAR
.Execute dbFailOnError
End With

With QDFAPITM
For Each PAR In .Parameters
PAR.Value = Eval(PAR.name)
Next PAR
.Execute dbFailOnError
End With


Dim reld As Boolean
Dim QDFHEADRST As DAO.QueryDef

Set QDFHEADRST = CurrentDb.CreateQueryDef("", "UPDATE [QUOTE JOB ITEMS] SET PRINT = 0 WHERE [QUOTE JOB ITEMS].[QUOTE ID] ='" & Me![JOB ID] & "'")


reld = DLookup("[RELS]", "JOBS", "[JOB NUMBER] ='" & Me![JOB NUMBER] & "'")

If Me![JOB NUMBER] Like "M*" And reld = False Then
'MsgBox "DELETING QJI"
Set QDFQTY = CurrentDb.CreateQueryDef("", "UPDATE [QUOTE JOB ITEMS] SET [PL INV QTY] = 0, PRINT = 0, [PL EXT] = 0,[SHIP DESCRIPTION] = NULL, [M SHIP DES] = NULL WHERE " _
& " [QUOTE JOB ITEMS].[QUOTE ID]='" & Me![JOB ID] & "' AND PRINT = -1 ")
Else
'MsgBox "DELETING REL ITEM"
Set QDFQTY = CurrentDb.CreateQueryDef("", "UPDATE [REL ITEMS] SET [REL ITEMS].[PL QTY] = 0, [REL ITEMS].PRINT = 0, [PL EXT AMT] = 0, [SHIP DES] = NULL, [M SHIP DES] = NULL WHERE " _
& " [REL ITEMS].[QUOTE ID] ='" & Me![JOB ID] & "' AND PRINT = -1")
End If
QDFQTY.Execute
QDFHEADRST.Execute dbFailOnError

'With QDFRSTPL
'For Each PAR In .Parameters
'PAR.Value = Eval(PAR.NAME)
'Next PAR
'.Execute dbFailOnError
'End With

QDFRSTPI.Execute dbFailOnError

WKS.CommitTrans
FTRAN = False

Dim QDFCHECK As DAO.QueryDef
Set QDFCHECK = CurrentDb.CreateQueryDef("", "SELECT * FROM [PL ITEMS A] WHERE HOLDER = " & Me![HOLDER] & " AND [PL QTY] > 0")
If QDFCHECK.ReturnsRecords = False Then
QDFRSTPL.Execute
Dim QDFDELREST As DAO.QueryDef
Set QDFDELREST = CurrentDb.CreateQueryDef("", "DELETE * FROM [PL ITEMS A] WHERE HOLDER =" & Me!HOLDER)
QDFDELREST.Execute
End If

With QDFRSTPL
For Each PAR In .Parameters
PAR.Value = Eval(PAR.name)
Next PAR
.Execute dbFailOnError
End With

'Check for Bill and Hold on current Shipping Record
strSQL = "SELECT * FROM [PL Inv Items] WHERE [Invoice Number] = " & INVNO & ";"
Set rst = DBCUR.OpenRecordset(strSQL)

With rst
If .RecordCount > 0 Then
.MoveFirst

Do Until .EOF
If .Fields(17) = True Then
strSQL = "UPDATE [PACKING LIST INVOICE] SET [PACKING LIST INVOICE].BillAndHold = True WHERE [Invoice Number] = " & INVNO & ";"
DBCUR.Execute strSQL

' Update Bill and Hold in RelItems table
strSQL1 = "UPDATE [REL ITEMS] SET [REL ITEMS].BillAndHold = True WHERE [REL ITEMS].[QUOTE ID] ='" & Me![JOB ID] & "';"
DBCUR.Execute strSQL1

Exit Do
End If

.MoveNext
Loop
End If
End With

DoCmd.OpenForm "PACKING LIST REPRINT"
Forms![PACKING LIST REPRINT].RecordSource = "SELECT * FROM [PACKING LIST INVOICE] WHERE [INVOICE NUMBER] =" & INVNO
DoCmd.CLOSE acForm, "PACKING LIST INVOICE"


EXIT_FINISH:
On Error Resume Next
Set WKS = Nothing
Set DBCUR = Nothing
rstgo.CLOSE
Set rstgo = Nothing
Set rst = Nothing
Exit Sub

ERR_FINISH:
If FTRAN = True Then
WKS.Rollback
MsgBox "ERROR CREATING PACKING LIST", vbOKOnly
Else
MsgBox "ERROR"
End If
Resume EXIT_FINISH

End Sub

 

[Derek Douglas]

I realize now that this line:

Set QDFAPITM = DBCUR.QueryDefs("APP PL ITEMS")

Is pulling different results than the original.

I do not understand why.