Need help with code "error # 3197"

R

RaulDR

Hi All,

This code will run several times, then I think It also corrupting my
database because after awhile the error 3197 appear although I was the only
one accessing the database at the moment.

Please help. Thanks!

Dim stSQl As String
Dim rsMainSupplier As Object
Dim rsValidOutnum As Object
Dim conCompliance As New ADODB.Connection

Me.Outlet_Type = "GTR"

stSQl = "Select * from Main_Supplier where Area = '" & Me.Area.Value &
"' " & _
" and Territory = '" & Me.Territory.Value & "' " & _
" and District = '" & Me.District.Value & "' " & _
" and Main_Supplier = '" & Me.Main_Supplier.Value & "' "

Set conCompliance = Application.CurrentProject.Connection
Set rsMainSupplier = CreateObject("ADODB.RECORDSET")
rsMainSupplier.Open stSQl, conCompliance, 1, adOpenStatic

If rsMainSupplier.RecordCount = 0 Then
MsgBox " " & Me.Main_Supplier.Value & " " & "does not belong to " & _
" " & Me.Area.Value & " Ter " & Me.Territory.Value & " Dist " &
Me.District.Value & " "
Cancel = True
Else
Me.MEP_Number = rsMainSupplier!MEP_Number
End If

rsMainSupplier.Close
Set rsMainSupplier = Nothing

'check for valid outlet number
stSQl = "Select * from Valid_Outnum where Area = '" & Me.Area.Value & "'
" & _
" and Territory = '" & Me.Territory.Value & "' " & _
" and District = '" & Me.District.Value & "' " & _
" and Outnum = '" & Left(Me.Outlet_Number.Value, 7) & "' order by Outnum"

Set rsValidOutnum = CreateObject("ADODB.RECORDSET")
rsValidOutnum.Open stSQl, conCompliance, 1, adOpenStatic

If rsValidOutnum.RecordCount = 0 Then
MsgBox " " & Me.Outlet_Number.Value & " " & "is a invalid Outlet
Number for " & _
" " & Me.Area.Value & " Ter " & Me.Territory.Value & " Dist " &
Me.District.Value & " "
Cancel = True
Me.Outlet_Number.SetFocus
End If


rsValidOutnum.Close
Set rsValidOutnum = Nothing

conCompliance.Close
Set conCompliance = Nothing
 
Top