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.
Thanks again for help here
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