Object variable or with block not set error

Thetaz1951

New member
Local time
Today, 15:45
Joined
Jan 21, 2014
Messages
6
This almost has to be a simple issue but I just do not see it. I have some code that will run if I am populating an empty table(no duplication's possible) but now I am trying to create a Sub to check for existence of a record and handling it going forward.
Anyways the big picture is looping through a text file and placing data where it needs to go. The code follows including some comments point to the issue.

Any help would be highly appreciated and make this next project less of a problem.

Code:
Sub PutinNewTag(TableIn As String, Tagtype As String, textline As String)
    Dim strSQL As String
    Dim NameIn As String
    Dim TagName As String
    Dim Db As DAO.Database
    Dim rstin As DAO.Recordset

    Dim PNTTYPE As DAO.Field

        NameIn = Trim(Mid$(textline, 5, 18))
        strSQL = "Select * from " & [TableIn] & _
                "WHERE " & [TagName] & " = " & NameIn & _
                "AND " & [PNTTYPE] & " = " & Tagtype
                
''''''Error is here   Object variable or With block not set.

        Set rstin = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
              
        If rstin.RecordCount > 0 Then
            MsgBox "This record exists"
        Else
            With rstin
                .AddNew
                !TagName.Value = NameIn
                !PNTTYPE.Value = UCase(Tagtype)
                .Update
                .Bookmark = .LastModified
            End With
        End If
End Sub

Function ReadIn()

On Error GoTo RI_Err
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim rstin As DAO.Recordset
    Dim TagName As DAO.Field
    Dim strSQL As String
    Dim Val As String
    Dim InPath As String
    Dim Loc As Long
    Dim ebname As String
    Dim ebfile As String
    Dim textline As String
    Dim NameIn As String
    Dim Tagtype As String
    Dim FieldIn As String
    Dim TableIn As String
    
    ' Return reference to current database.
    Set dbs = CurrentDb
    
    ' Open Input table for data
    Set rst = dbs.OpenRecordset("Input", dbOpenDynaset)
        rst.MoveFirst
        InPath = rst!InPath.Value
    rst.Close
       
    ebname = "UCN07_03.EB"
    ebfile = InPath & "\" & ebname
      Do While ebfile <> ""
        Open ebfile For Input As #1
        Seek #1, 1
        Do Until EOF(1)
          Line Input #1, textline
            If Left$(textline, 14) = "{SYSTEM ENTITY" Then GoTo LOOP2
            If Left$(textline, 2) = "&T" Then
                Tagtype = Trim(Mid$(textline, 4, 40))
                If Tagtype = "ANINNIM" Then
                TableIn = "UAIT"
                GoTo LOOP2
                End If
                If Tagtype = "ANOUTNIM" Then
                TableIn = "UAOT"
                GoTo LOOP2
                End If
                If Tagtype = "DICMPNIM" Then
                TableIn = "UDCT"
                GoTo LOOP2
                End If
                If Tagtype = "DIINNIM" Then
                TableIn = "UDIT"
                GoTo LOOP2
                End If
                If Tagtype = "DIOUTNIM" Then
                TableIn = "UDOT"
                GoTo LOOP2
                End If
                If Tagtype = "FLAGNIM" Then
                TableIn = "UFLGT"
                GoTo LOOP2
                End If
                If Tagtype = "NUMERNIM" Then
                TableIn = "UNUMT"
                GoTo LOOP2
                End If
                If Tagtype = "REGCLNIM" Then
                TableIn = "UREGCT"
                GoTo LOOP2
                End If
                If Tagtype = "REGPVNIM" Then
                TableIn = "UREGPVT"
                GoTo LOOP2
                End If
            End If
            
'''' This code works in an empty table - curently comented below 
'        but i need to check for existing Tagnames so            
            If Left$(textline, 2) = "&N" Then
                Call PutinNewTag(TableIn, Tagtype, textline)
                'strSQL = "Select * from " & TableIn
                'Set rstin = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
                'NameIn = Trim(Mid$(textline, 4, 18))
                'With rstin
                '    .AddNew
                '    !Name.Value = NameIn
                '    !PNTTYPE.Value = UCase(Tagtype)
                '    .Update
                '    .Bookmark = .LastModified
                'End With
                GoTo LOOP2
            End If
'''' The Call to the Sub is where it fails

            Loc = InStr(1, textline, "=", 1)
            If Loc <> 0 Then
                FieldIn = Trim(Left$(textline, Loc - 1))
                Val = Trim(Mid(textline, Loc + 1, 42))
                Val = Replace(Val, """", "")
                Val = Trim(Val)
                With rstin
                    .Edit
                    .Fields(FieldIn) = Val
                    .Update
                End With
            End If

LOOP2:  Loop
        Close #1
        Kill InPath + "\" + ebfile
        ebfile = InPath & "\" & ebname
LOOP3:  Loop
 

    ' Free all object Variables
RI_Empty:
    rst.Close
    rstin.Close
    Set dbs = Nothing
    
RI_Exit:
    Exit Function

RI_Err:
    Debug.Print TableIn
    Debug.Print NameIn
    Debug.Print FieldIn
    Debug.Print Val
    MsgBox Error$
    Close #1
    Set dbs = Nothing
    Resume RI_Exit
    
End Function

Thanks again for help here
 
You have Dim the TagName, but where have you set the value for it? Based on this the generated SQL would be.
Code:
SELECT * FROM someTable WHE[COLOR=Red][B]RE = someFi[/B][/COLOR]el[COLOR=Red][B]dAND som[/B][/COLOR]ePinType = something
Also why have you declared PINTYPE as DAO.Field? That is the problem for the error.
 
Tagname is a field of the Table I am working in, I am attempting to populate that field if not already there. I see I have set it as two different types (Field and String) in the Function and the Sub - will correct that one. Still have the same error.
 
The StrSql is already in the code, though there is something wrong here and I do nto know what it is, baffling to this one.
Code:
 strSQL = "Select * from " & [TableIn] & _
                "WHERE " & [TagName] & " = " & NameIn & _
                "AND " & [PNTTYPE] & " = " & Tagtype

That is from the code above
 
Okay I corrected the dimension issue but the error still exists, the corrected code is below

Code:
Sub PutinNewTag(TableIn As String, Tagtype As String, textline As String)
    Dim strSQL As String
    Dim NameIn As String
    Dim TagName As String
    Dim Db As DAO.Database
    Dim rstin As DAO.Recordset

    Dim PNTTYPE As DAO.Field

        NameIn = Trim(Mid$(textline, 5, 18))
        strSQL = "Select * from " & [TableIn] & _
                "WHERE " & [TagName] & " = " & NameIn & _
                "AND " & [PNTTYPE] & " = " & Tagtype
                
''''''Error is here   Object variable or With block not set.

        Set rstin = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
              
        If rstin.RecordCount > 0 Then
            MsgBox "This record exists"
        Else
            With rstin
                .AddNew
                !TagName.Value = NameIn
                !PNTTYPE.Value = UCase(Tagtype)
                .Update
                .Bookmark = .LastModified
            End With
        End If
End Sub

Function ReadIn()

On Error GoTo RI_Err
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim rstin As DAO.Recordset
    Dim TagName As String
    Dim strSQL As String
    Dim Val As String
    Dim InPath As String
    Dim Loc As Long
    Dim ebname As String
    Dim ebfile As String
    Dim textline As String
    Dim NameIn As String
    Dim Tagtype As String
    Dim FieldIn As String
    Dim TableIn As String
    
    ' Return reference to current database.
    Set dbs = CurrentDb
    
    ' Open Input table for data
    Set rst = dbs.OpenRecordset("Input", dbOpenDynaset)
        rst.MoveFirst
        InPath = rst!InPath.Value
    rst.Close
       
    ebname = "UCN07_03.EB"
    ebfile = InPath & "\" & ebname
      Do While ebfile <> ""
        Open ebfile For Input As #1
        Seek #1, 1
        Do Until EOF(1)
          Line Input #1, textline
            If Left$(textline, 14) = "{SYSTEM ENTITY" Then GoTo LOOP2
            If Left$(textline, 2) = "&T" Then
                Tagtype = Trim(Mid$(textline, 4, 40))
                If Tagtype = "ANINNIM" Then
                TableIn = "UAIT"
                GoTo LOOP2
                End If
                If Tagtype = "ANOUTNIM" Then
                TableIn = "UAOT"
                GoTo LOOP2
                End If
                If Tagtype = "DICMPNIM" Then
                TableIn = "UDCT"
                GoTo LOOP2
                End If
                If Tagtype = "DIINNIM" Then
                TableIn = "UDIT"
                GoTo LOOP2
                End If
                If Tagtype = "DIOUTNIM" Then
                TableIn = "UDOT"
                GoTo LOOP2
                End If
                If Tagtype = "FLAGNIM" Then
                TableIn = "UFLGT"
                GoTo LOOP2
                End If
                If Tagtype = "NUMERNIM" Then
                TableIn = "UNUMT"
                GoTo LOOP2
                End If
                If Tagtype = "REGCLNIM" Then
                TableIn = "UREGCT"
                GoTo LOOP2
                End If
                If Tagtype = "REGPVNIM" Then
                TableIn = "UREGPVT"
                GoTo LOOP2
                End If
            End If
            
'''' This code works in an empty table - curently comented below 
'        but i need to check for existing Tagnames so            
            If Left$(textline, 2) = "&N" Then
                Call PutinNewTag(TableIn, Tagtype, textline)
                'strSQL = "Select * from " & TableIn
                'Set rstin = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
                'NameIn = Trim(Mid$(textline, 4, 18))
                'With rstin
                '    .AddNew
                '    !Name.Value = NameIn
                '    !PNTTYPE.Value = UCase(Tagtype)
                '    .Update
                '    .Bookmark = .LastModified
                'End With
                GoTo LOOP2
            End If
'''' The Call to the Sub is where it fails

            Loc = InStr(1, textline, "=", 1)
            If Loc <> 0 Then
                FieldIn = Trim(Left$(textline, Loc - 1))
                Val = Trim(Mid(textline, Loc + 1, 42))
                Val = Replace(Val, """", "")
                Val = Trim(Val)
                With rstin
                    .Edit
                    .Fields(FieldIn) = Val
                    .Update
                End With
            End If

LOOP2:  Loop
        Close #1
        Kill InPath + "\" + ebfile
        ebfile = InPath & "\" & ebname
LOOP3:  Loop
 

    ' Free all object Variables
RI_Empty:
    rst.Close
    rstin.Close
    Set dbs = Nothing
    
RI_Exit:
    Exit Function

RI_Err:
    Debug.Print TableIn
    Debug.Print NameIn
    Debug.Print FieldIn
    Debug.Print Val
    MsgBox Error$
    Close #1
    Set dbs = Nothing
    Resume RI_Exit
    
End Function

There is extraneous stuff in here from troubleshooting other issues.

Thanks
 
I think you have syntax errors in this (untested)
Code:
strSQL = "Select * from " & [TableIn] & _
                "  WHERE " & [TagName] & " = [COLOR="Red"]'[/COLOR]" & NameIn & _
               "[COLOR="Red"]'  A[/COLOR]ND " & [PNTTYPE] & " = [COLOR="Red"]'[/COLOR]" & Tagtype  & "[COLOR="Red"]'[/COLOR]"

And these have nothing to do with the current error
 
Last edited:
Thanks for that one jdraw though as you said it made no differenece.
 
Do you still have PNTTYPE as a dao.Field? I think that's an issue.
 

Users who are viewing this thread

Back
Top Bottom