asked on

object variable or with block not set

I have an access error but I am not sure why I am getting it

the for loop runs ok.

some help would be appreciated

Private Sub BtnRunComparitor_Click()

On Error GoTo ControlExit

Dim db As Database
Set db = CurrentDb
Dim MaxDateBuild As String
Dim LResponse As Integer
Dim MaxdateEvents As String
Dim TableNameCurrent As Variant
Dim TableNamePrevious As String
Dim ClientCodeName As String
Dim ClientName As String
Dim tempstr As String
Dim fld As DAO.Field
Dim index As Long
Dim TableFieldCount As Long
Dim BatchName As String
Dim ModelID As String

DoCmd.SetWarnings False



If InStr(Application.CurrentProject.Name, "Abi") Then
    ClientName = "Abi"
    
End If


If InStr(Application.CurrentProject.Name, "Glass") Then
ClientName = "Glass"

End If


If InStr(Application.CurrentProject.Name, "Tvi") Then

ClientName = "Tvi"

End If

If InStr(Application.CurrentProject.Name, "Cap") Then
ClientName = "Cap"

End If




Select Case ClientName
Case "Abi"
    TableNameCurrent = "[tClient]"
    TableNamePrevious = "[tClient PREV]"
    ClientCodeName = "ClientCode"

    ClientCodeNameFull = "AbiCode"
    ModelID = "AbiCode"
    BatchName = "Batch"
    VehCatName = "VehCat"




Case "ADL"
TableName = ""
Case "CAP"
TableNameCurrent = "[CAPDATA]"
    TableNamePrevious = "[CAPDATA PREV]"
    ClientCodeName = "ClientCode"
    
    ClientCodeNameFull = "CAPid_CAPcat"
    ModelID = "CapVehicleID"
    BatchName = "BATCH"
    VehCatName = "CAP_cat"


Case "FEBI"
TableName = ""
Case "GLASS"
    TableNameCurrent = "[Glass Full Table]"
    TableNamePrevious = "[Glass Full Table PREV]"
    ClientCodeName = "ClientCode"
    
    ClientCodeNameFull = "GLASSid_GLASScat"
    ModelID = "Model_id"
    BatchName = "BATCH"
    VehCatName = "GLASS_cat"
Case "HALFORDS"
    TableName = ""
Case "HAYNES_PRO"
    TableName = ""
Case "KEE"
    TableName = ""
Case "KWIK_FIT"
    TableName = ""
Case "MAM"
    TableName = ""
Case "SMMT"
    TableName = "[SMMT]"
Case "TECDOC"
    TableName = ""
Case "TVI"
    TableName = "[TVIData]"
Case "TYRES"
    TableName = ""
Case Else
    MsgBox ("Shouldnt be here speak to Peter Bailey")

End Select

index = 0
TableFieldCount = db.TableDefs(TableNameCurrent).Fields.Count - 1

'number of slices for incrementing progress bar
lngSlices = Int(TableFieldCount)
Set ctl = Me.shpProgressBar

'Increment slice number
k = 0
i = 0

'Full control width is 5700 twips
lngSliceWidth = 5700 / lngSlices

'Set progress bar to starting position
ctl.Width = 0
Me.LblDerivation.Visible = False
Me.LblStartTime.Visible = False
Me.LblEndTime.Visible = False
Me.LblProcessTime.Visible = False

StartAt = Now
Me.LblStartTime.Caption = "Start time: " & StartAt
Me.LblStartTime.Visible = True
Me.LblDerivation.Visible = True
Me.LblDerivation.Caption = "Comparitor started"

MaxDateBuild = GetMaxBatchDate(ClientName, "CurrentBuild")

    For Each fld In db.TableDefs(TableNameCurrent).Fields
    '    MsgBox fld.Name
        
        If fld.Name = ClientCodeNameFull Or fld.Name = BatchName Or fld.Name = ModelID Then
        'ignore these fields
        
        Else
        'process these fields
   
        Select Case fld.Type
        Case 3 To 4
            Debug.Print fld.Name
            Debug.Print fld.Type
            tempstr = "INSERT INTO [TblCompareEvents](" & ClientCodeName & ", [Prev], [Change], ChangeYearMonth, VehicleCategory, Matched, ActualVariance, PKCodeChangeYearMonthField)" _
            & " SELECT QryClientDifferencesLogic." & ClientCodeNameFull & ", " & TableNamePrevious & ".[" & fld.Name & "], " & TableNameCurrent & ".[" & fld.Name & "],'" & GetMaxBatchDate(ClientName, "CurrentBuild") & "' AS ChangeYearMonth, QryClientDifferencesLogic." & VehCatName & " AS VehicleCategory, IsMatched(QryClientDifferencesLogic." & ClientCodeNameFull & ",'" & ClientName & "') AS Matched, Round(Abs(Nz(" & TableNameCurrent & ".[" & fld.Name & "])-" & TableNamePrevious & ".[" & fld.Name & "])) AS ActualVariance, QryClientDifferencesLogic.[" & ClientCodeNameFull & "] & '" & GetMaxBatchDate(ClientName, "CurrentBuild") & "' & '" & fld.Name & "' & [Glass Full Table PREV].[Manufacturer_desc] & [Glass Full Table].[Manufacturer_desc] AS PK FROM" _
            & " (QryClientDifferencesLogic LEFT JOIN " & TableNamePrevious & " ON QryClientDifferencesLogic." & ClientCodeNameFull & "= " & TableNamePrevious & "." & ClientCodeNameFull & ") LEFT JOIN " & TableNameCurrent & " " _
            & " ON QryClientDifferencesLogic." & ClientCodeNameFull & "=" & TableNameCurrent & "." & ClientCodeNameFull & " WHERE (((QryClientDifferencesLogic.[" & fld.Name & "Diff])=-1));"
            Debug.Print tempstr
            'Update the progress bar
            k = k + 1
            ctl.Width = lngSliceWidth * k
            Me.LblDerivation.Caption = fld.Name & " Events added"
            Forms!FrmGate.Repaint
        Case Else
            Debug.Print fld.Name
            Debug.Print fld.Type
            tempstr = "INSERT INTO [TblCompareEvents](" & ClientCodeName & ", [Prev], [Change], ChangeYearMonth, VehicleCategory, Matched, PKCodeChangeYearMonthField)" _
            & " SELECT QryClientDifferencesLogic." & ClientCodeNameFull & ", " & TableNamePrevious & ".[" & fld.Name & "], " & TableNameCurrent & ".[" & fld.Name & "],'" & GetMaxBatchDate(ClientName, "CurrentBuild") & "' AS ChangeYearMonth, QryClientDifferencesLogic." & VehCatName & " AS VehicleCategory, IsMatched(QryClientDifferencesLogic." & ClientCodeNameFull & ",'" & ClientName & "') AS Matched, QryClientDifferencesLogic.[" & ClientCodeNameFull & "] & '" & GetMaxBatchDate(ClientName, "CurrentBuild") & "' & '" & fld.Name & "' & [Glass Full Table PREV].[Manufacturer_desc] & [Glass Full Table].[Manufacturer_desc] AS PK FROM" _
            & " (QryClientDifferencesLogic LEFT JOIN " & TableNamePrevious & " ON QryClientDifferencesLogic." & ClientCodeNameFull & "= " & TableNamePrevious & "." & ClientCodeNameFull & ") LEFT JOIN " & TableNameCurrent & " " _
            & " ON QryClientDifferencesLogic." & ClientCodeNameFull & "=" & TableNameCurrent & "." & ClientCodeNameFull & " WHERE (((QryClientDifferencesLogic.[" & fld.Name & "Diff])=-1));"
            Debug.Print tempstr
            
   
            'Update the progress bar
            k = k + 1
            ctl.Width = lngSliceWidth * k
            Me.LblDerivation.Caption = fld.Name & " Events added"
            Forms!FrmGate.Repaint
            
        End Select
    
            DoCmd.RunSQL tempstr

        End If
    index = index + 1
    Next
    

   x = SetEvent(4, ClientName)
       

   'Update the progress bar
            k = k + 1
            ctl.Width = lngSliceWidth * k
            Me.LblDerivation.Caption = fld.Name & " Saving Batch N Drive"
            Forms!FrmGate.Repaint
            
DoCmd.RunSQL "INSERT INTO TblBatchComparisons ( ClientCode, Change, Batch, Prev, ActualVariance, VehicleCategory, Matched, PKCodeChangeYearMonthField )" _
& " SELECT QryAllChangesCurrentBatch.ClientCode, QryAllChangesCurrentBatch.Change, QryAllChangesCurrentBatch.ChangeYearMonth, QryAllChangesCurrentBatch.Prev, QryAllChangesCurrentBatch.ActualVariance, QryAllChangesCurrentBatch.VehicleCategory, QryAllChangesCurrentBatch.Matched, QryAllChangesCurrentBatch.PKCodeChangeYearMonthField" _
& " FROM QryAllChangesCurrentBatch;"

MsgBox (ClientName & " Comparitor Task Set as complete")

EndAt = Now
Me.LblEndTime.Caption = "End time: " & EndAt
Me.LblProcessTime.Caption = "Processing time: " & Format(EndAt - StartAt, "hh:nn:ss")
Me.LblEndTime.Visible = True
Me.LblProcessTime.Visible = True
DoCmd.SetWarnings True



ControlExit_Exit:
    Exit Sub

ControlExit:
     If Err.Number = 3022 Then
        'no message
        Else
        MsgBox Error$
    End If
    Resume ControlExit_Exit


End Sub

Open in new window

darbid73

I think that this is a good opportunity to learn to debug, in the process you will narrow down where the error is and I bet be able to answer your question yourself.

Put a break point on line 25 and then hit F8.

ASKER CERTIFIED SOLUTION

Rey Obrero (Capricorn1)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

PeterBaileyUk

ASKER

I did debug in answer to darbid, I wouldnt post the question if I hadnt used F8 however, it wasnt showing me where.

in answer to that Rey has told me how to see that.

I will comment out and try debugging again.

darbid73

Yep follow Rey suggestion as it will mean you do not have to debug by pressing F8. It will error on the problem line of code.

Dale Fye

I would also strongly recommend that you get rid of the:

DoCmd.SetWarnings false

lines of code as well. Use of this technique is a recipe for errors and future problems unless you have really robust error handling. For example, the bottom of your code looks like:

DoCmd.SetWarnings True

ControlExit_Exit:
    Exit Sub

ControlExit:
     If Err.Number = 3022 Then
        'no message
        Else
        MsgBox Error$
    End If
    Resume ControlExit_Exit

Open in new window

In this example, when your code raises an error, you resume control at ControlExit_Exit, and the:

DoCmd.SetWarnings True

gets bypassed, which is really, really bad. As a minimum, you need to move the DoCmd.SetWarnings True line to just below the ControlExit_Exit line. You might also want to consider changing the name of your error handler to something like ControlError rather than ControlExit, as that is much more readable and makes a lot more sense.

PeterBaileyUk

ASKER

Thank you this was the way to go and halted on the code causing the problem..I also note the other experts opinions and thank you for them.