VBA works in orignal but fails in copy of database

Discussion in 'Access' started by Derek Douglas, Feb 27, 2017.

  1. Derek Douglas

    Derek Douglas

    Joined:
    Feb 27, 2017
    Messages:
    2
    Likes Received:
    0
    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, Feb 27, 2017
    #1
    1. Advertisements

  2. Derek Douglas

    Derek Douglas

    Joined:
    Feb 27, 2017
    Messages:
    2
    Likes Received:
    0
    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.
     
    Derek Douglas, Feb 27, 2017
    #2
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.