Run Time Error 3201

**dongodu** · May 28th, 2012, 09:25 AM

Code:

Dim cnuser As New ADODB.connection
 Dim rsupdate As New ADODB.Recordset
 Dim reply As String
  
    'Call connection(cnuser, App.Path & "\Medrar.mdb", "endromida")
    Call connection(cnuser, "\\mika\medrar\Medrar.mdb", "endromida")
    Call Recordset(rsupdate, cnuser, "SELECT l_status,lnum FROM Lands where lnum = ' & txtLaLanum.Text & '")
    
'    reply = rsupdate.Fields!condi
    
    With rsupdate
    If rsupdate.BOF = True Then
    .Fields!l_status = txtText2.Text
    .Update
     End If
   End With
   
Set cnuser = Nothing
Set rsupdate = Nothing

**DataMiser** · May 28th, 2012, 09:34 AM

You should always give the error message and not just the number. It may surprise you but most of us have not memorized the thousands of error messages that are possible.

**WoF** · May 29th, 2012, 07:10 AM

And then, it would be of enormous value if you could indicate the line which produces the error, which would help tremendously to spot the problem.
Also, using [ code ] [ /code ] tags (without the blanks) would make your code much better readable.

**dongodu** · May 29th, 2012, 09:32 AM

Check this Error Msg

**DataMiser** · May 29th, 2012, 11:50 AM

Code:

with rsupdate
    If rsupdate.BOF = True Then
        .Fields!l_status = txtText2.Text
        .Update
    End If
End With

If BOF = True then you have no curent record and therefore you can not update it.

Code:

If .BOF=False And .EOF=False Then

Means that you have an active record an can update.

**dongodu** · May 30th, 2012, 11:43 AM

Thanks alot, but record is not updating????
No Errors thrown

**DataMiser** · May 30th, 2012, 11:59 AM

Show the code you are using now.

**dongodu** · May 31st, 2012, 09:01 AM

Please verify attached txt file for reference.
Thank you very much in advance

**DataMiser** · May 31st, 2012, 09:46 AM

Post the section of code that is not working into a message like you did in the first post.

**dongodu** · June 2nd, 2012, 01:40 AM

Code:

Option Explicit

Dim cd As ADODB.connection
Dim rs As ADODB.Recordset

Dim rd As ADODB.connection
Dim cs As ADODB.Recordset

Dim fd As ADODB.connection
Dim Fs As ADODB.Recordset

Dim kr As ADODB.connection
Dim kp As ADODB.Recordset

Dim rr As ADODB.connection
Dim rp As ADODB.Recordset

Private ForeColors(0 To 2, 0 To 1) As Long
Private BackColors(0 To 2, 0 To 1) As Long
Private Sub cmdLaPrint_Click()
RptSalesRecipt.Show
End Sub
Private Sub rsn()
Call autogen
Call Agr
SaSno = autogen
ActNo = Agr
frmSales.txtReSeri.Text = SaSno
frmSales.txtReAgno.Text = Agr
frmSales.txtResDate.Text = Date
End Sub

'--------------------------------------------------------------------------
'Reservation Sales
'--------------------------------------------------------------------------
Private Sub cmdReSave_Click()

Dim cnuser As New ADODB.connection
Dim rsuser As New ADODB.Recordset

If sempty(txtReSeri.Text) = True Then Exit Sub
If sempty(txtResDate.Text) = True Then Exit Sub
If sempty(txtReAgno.Text) = True Then Exit Sub
If sempty(txtReSal.Text) = True Then Exit Sub
If sempty(txtRe1stCus.Text) = True Then Exit Sub
If sempty(txtRe1stID.Text) = True Then Exit Sub
If sempty(txtRe1stMob.Text) = True Then Exit Sub
If sempty(txtCusna.Text) = True Then Exit Sub
If sempty(txtCuId.Text) = True Then Exit Sub
If sempty(txtCuMobi.Text) = True Then Exit Sub
If sempty(txtSaProN.Text) = True Then Exit Sub
If sempty(txtSaProC.Text) = True Then Exit Sub
If sempty(txtSaBlk.Text) = True Then Exit Sub
If sempty(txtSaLan.Text) = True Then Exit Sub
If sempty(txtSaSQL.Text) = True Then Exit Sub
If sempty(txtSaPr.Text) = True Then Exit Sub
If sempty(txtReNetTot.Text) = True Then Exit Sub
If sempty(txtReE.Text) = True Then Exit Sub
If sempty(txtReWe.Text) = True Then Exit Sub
If sempty(txtReNo.Text) = True Then Exit Sub
If sempty(txtReSo.Text) = True Then Exit Sub
If sempty(txtRecomi.Text) = True Then Exit Sub
If sempty(txtReAdd.Text) = True Then Exit Sub
If sempty(txtReded.Text) = True Then Exit Sub
If sempty(txtReTot.Text) = True Then Exit Sub
If sempty(txtRePA.Text) = True Then Exit Sub
If sempty(txtReGtot.Text) = True Then Exit Sub
If sempty(txtRem1.Text) = True Then Exit Sub
If sempty(txtRem2.Text) = True Then Exit Sub

'Call connection(cnuser, App.Path & "\Medrar.mdb", "endromida")
Call connection(cnuser, "\\mika\medrar\Medrar.mdb", "endromida")
Call Recordset(rsuser, cnuser, "SELECT * FROM sales")



With rsuser
.AddNew
.Fields!SaSno = txtReSeri.Text
.Fields!saDate = txtResDate.Text
.Fields!ActNo = txtReAgno.Text
.Fields!fname = txtReSal.Text
.Fields!bname = txtRe1stCus.Text
.Fields!icard = txtRe1stID.Text
.Fields!mobily = txtRe1stMob.Text
.Fields!cti = txtCit.Text
.Fields!pi = txtPIA.Text
.Fields!epd = txtDP.Text
.Fields!Fullname = txtCusna.Text
.Fields!idcn = txtCuId.Text
.Fields!mobile = txtCuMobi
.Fields!nta = txtNat.Text
.Fields!iop = txtPOI.Text
.Fields!di = txtDIS.Text
.Fields!projn = txtSaProN.Text
.Fields!projc = txtSaProC.Text
.Fields!blono = txtSaBlk.Text
.Fields!lano = txtSaLan.Text
.Fields!SQL = txtSaSQL.Text
.Fields!saprice = txtSaPr.Text
.Fields!nettot = txtReNetTot.Text
.Fields!east = txtReE.Text
.Fields!west = txtReWe.Text
.Fields!north = txtReNo.Text
.Fields!south = txtReSo.Text
.Fields!commo = txtRecomi.Text
.Fields!add = txtReAdd.Text
.Fields!dedc = txtReded.Text
.Fields!total = txtReTot.Text
.Fields!paied = txtRePA.Text
.Fields!grand = txtReGtot
.Fields!rem1 = txtRem1.Text
.Fields!rem2 = txtRem2.Text
.Fields!gtw = Text7.Text
.Fields!typ = txtretyp.Text
.Fields!regno = txtRSRegno.Text
.Fields!regdt = txtRSregdt.Text
.Fields!hij = Text3.Text
.Fields!ptw = Text5.Text
Call sl
.Fields!status = txtText2.Text
'Call lap

.Update
End With

MsgBox "Reserve Land Sales Done.", vbInformation
Call laup ---> Error
Call viewres


Set cnuser = Nothing
Set rsuser = Nothing

End Sub
Private Sub renet()
txtReNetTot.Text = val(txtSaSQL.Text) * val(txtSaPr.Text)
End Sub
Private Sub txtSaPr_Change()
Call renet
Call recomi
End Sub
Private Sub recomi()
txtRecomi.Text = val(txtReNetTot.Text) * 2.5 / 100
End Sub
Private Sub Ret()
txtReTot.Text = val(txtReNetTot.Text) + val(txtRecomi.Text) + val(txtReAdd.Text) - val(txtReded.Text)
End Sub
Private Sub txtReAdd_Change()
Call Ret
End Sub
Private Sub txtreded_change()
Call Ret
End Sub
Private Sub txtReGtot_Change()
Frame11.Visible = True
'Text7.Text = NumberToWords(txtReGtot.Text)
Text7.Text = Arb(txtReGtot.Text)
End Sub
Private Sub Regtot()
txtReGtot.Text = val(txtReTot.Text) - val(txtRePA.Text)
End Sub
Private Sub txtReTot_Change()
Call Regtot
End Sub
Private Sub txtRePA_Change()
'Text5.Text = NumberToWords(txtRePA.Text)
Text5.Text = Arb(txtRePA.Text)
Call Regtot
End Sub
Private Sub sl()
'txtText2.Text = "ãÈÇÚ"
txtText2.Text = "Test"
End Sub
Private Sub laup()

 Dim cnuser As New ADODB.connection
 Dim rsupdate As New ADODB.Recordset
 Dim reply As String
  
    'Call connection(cnuser, App.Path & "\Medrar.mdb", "endromida")
    Call connection(cnuser, "\\mika\medrar\Medrar.mdb", "endromida")
    Call Recordset(rsupdate, cnuser, "SELECT l_status,lnum FROM Lands where lnum = ' & txtLaLanum.Text & '")
    
'    reply = rsupdate.Fields!condi
    
    With rsupdate
    If .BOF = True And .EOF = True Then
    .Fields!l_status = txtText2.Text
    .Update
     End If
   End With
   
Set cnuser = Nothing
Set rsupdate = Nothing

End Sub
Private Sub lap()

 Dim cnuser As New ADODB.connection
  Dim rsupdate As New ADODB.Recordset
  Dim reply As String
  
    'Call connection(cnuser, App.Path & "\Medrar.mdb", "endromida")
    Call connection(cnuser, "\\mika\medrar\Medrar.mdb", "endromida")
    Call Recordset(rsupdate, cnuser, "SELECT condi,lannum FROM reser where lannum = ' & txtSaLan.Text & '")
    
   ' reply = rsupdate.Fields!c_status
    
    With rsupdate
    .Fields!condi = txtText2.Text
'    .Update
    End With
      
    
Set cnuser = Nothing
Set rsupdate = Nothing

End Sub
Function ConvertDateString( _
    ByRef StringIn As String, _
    ByRef OldCalendar As Integer, _
    ByVal NewCalendar As Integer, _
    ByRef NewFormat As String) As String
    
    Dim SavedCal As Integer
    Dim d As Date
    Dim s As String
    
    '// Save VBA Calendar setting to restore when finished
    SavedCal = Calendar
    
    '// Convert date to new calendar and format
    Calendar = OldCalendar      ' Change to StringIn calendar
    d = CDate(StringIn)       ' Convert from String to Date
    Calendar = NewCalendar      ' Change to calendar of new string
    s = CStr(d)          ' Convert to short format String
    ConvertDateString = Format(s, NewFormat)
    
    '// Restore VBA Calendar setting
    Calendar = SavedCal
End Function
Private Sub Rhij()
Text3.Text = ConvertDateString(txtResDate.Text, 0, 1, "yyyy/mm/dd")
End Sub
Private Sub Shij()
txtText4.Text = ConvertDateString(txtSadate.Text, 0, 1, "yyyy/mm/dd")
End Sub

**firoz.raj** · June 2nd, 2012, 08:45 AM

Please always write the code in the code tags .

Code:

Private Sub cmdReSave_Click()

Dim cnuser As New ADODB.connection
Dim rsuser As New ADODB.Recordset

If sempty(txtReSeri.Text) = True Then Exit Sub
If sempty(txtResDate.Text) = True Then Exit Sub
If sempty(txtReAgno.Text) = True Then Exit Sub
If sempty(txtReSal.Text) = True Then Exit Sub
If sempty(txtRe1stCus.Text) = True Then Exit Sub
If sempty(txtRe1stID.Text) = True Then Exit Sub
If sempty(txtRe1stMob.Text) = True Then Exit Sub
If sempty(txtCusna.Text) = True Then Exit Sub
If sempty(txtCuId.Text) = True Then Exit Sub
If sempty(txtCuMobi.Text) = True Then Exit Sub
If sempty(txtSaProN.Text) = True Then Exit Sub
If sempty(txtSaProC.Text) = True Then Exit Sub
If sempty(txtSaBlk.Text) = True Then Exit Sub
If sempty(txtSaLan.Text) = True Then Exit Sub
If sempty(txtSaSQL.Text) = True Then Exit Sub
If sempty(txtSaPr.Text) = True Then Exit Sub
If sempty(txtReNetTot.Text) = True Then Exit Sub
If sempty(txtReE.Text) = True Then Exit Sub
If sempty(txtReWe.Text) = True Then Exit Sub
If sempty(txtReNo.Text) = True Then Exit Sub
If sempty(txtReSo.Text) = True Then Exit Sub
If sempty(txtRecomi.Text) = True Then Exit Sub
If sempty(txtReAdd.Text) = True Then Exit Sub
If sempty(txtReded.Text) = True Then Exit Sub
If sempty(txtReTot.Text) = True Then Exit Sub
If sempty(txtRePA.Text) = True Then Exit Sub
If sempty(txtReGtot.Text) = True Then Exit Sub
If sempty(txtRem1.Text) = True Then Exit Sub
If sempty(txtRem2.Text) = True Then Exit Sub

'Call connection(cnuser, App.Path & "\Medrar.mdb", "endromida")
Call connection(cnuser, "\\mika\medrar\Medrar.mdb", "endromida")
Call Recordset(rsuser, cnuser, "SELECT * FROM sales")



With rsuser
.AddNew
.Fields!SaSno = txtReSeri.Text
.Fields!saDate = txtResDate.Text
.Fields!ActNo = txtReAgno.Text
.Fields!fname = txtReSal.Text
.Fields!bname = txtRe1stCus.Text
.Fields!icard = txtRe1stID.Text
.Fields!mobily = txtRe1stMob.Text
.Fields!cti = txtCit.Text
.Fields!pi = txtPIA.Text
.Fields!epd = txtDP.Text
.Fields!Fullname = txtCusna.Text
.Fields!idcn = txtCuId.Text
.Fields!mobile = txtCuMobi
.Fields!nta = txtNat.Text
.Fields!iop = txtPOI.Text
.Fields!di = txtDIS.Text
.Fields!projn = txtSaProN.Text
.Fields!projc = txtSaProC.Text
.Fields!blono = txtSaBlk.Text
.Fields!lano = txtSaLan.Text
.Fields!SQL = txtSaSQL.Text
.Fields!saprice = txtSaPr.Text
.Fields!nettot = txtReNetTot.Text
.Fields!east = txtReE.Text
.Fields!west = txtReWe.Text
.Fields!north = txtReNo.Text
.Fields!south = txtReSo.Text
.Fields!commo = txtRecomi.Text
.Fields!add = txtReAdd.Text
.Fields!dedc = txtReded.Text
.Fields!total = txtReTot.Text
.Fields!paied = txtRePA.Text
.Fields!grand = txtReGtot
.Fields!rem1 = txtRem1.Text
.Fields!rem2 = txtRem2.Text
.Fields!gtw = Text7.Text
.Fields!typ = txtretyp.Text
.Fields!regno = txtRSRegno.Text
.Fields!regdt = txtRSregdt.Text
.Fields!hij = Text3.Text
.Fields!ptw = Text5.Text
Call sl
.Fields!Status = txtText2.Text
'Call lap
Call laup
.Update
End With

MsgBox "Reserve Land Sales Done.", vbInformation

Call viewres


Set cnuser = Nothing
Set rsuser = Nothing

End Sub
Private Sub renet()
txtReNetTot.Text = val(txtSaSQL.Text) * val(txtSaPr.Text)
End Sub
Private Sub txtSaPr_Change()
Call renet
Call recomi
End Sub
Private Sub recomi()
txtRecomi.Text = val(txtReNetTot.Text) * 2.5 / 100
End Sub
Private Sub Ret()
txtReTot.Text = val(txtReNetTot.Text) + val(txtRecomi.Text) + val(txtReAdd.Text) - val(txtReded.Text)
End Sub
Private Sub txtReAdd_Change()
Call Ret
End Sub
Private Sub txtreded_change()
Call Ret
End Sub
Private Sub txtReGtot_Change()
Frame11.Visible = True
'Text7.Text = NumberToWords(txtReGtot.Text)
Text7.Text = Arb(txtReGtot.Text)
End Sub
Private Sub Regtot()
txtReGtot.Text = val(txtReTot.Text) - val(txtRePA.Text)
End Sub
Private Sub txtReTot_Change()
Call Regtot
End Sub
Private Sub txtRePA_Change()
'Text5.Text = NumberToWords(txtRePA.Text)
Text5.Text = Arb(txtRePA.Text)
Call Regtot
End Sub
Private Sub txtreseri_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtResDate.SetFocus
End If

End Sub
Private Sub txtresdate_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtReAgno.SetFocus
End If

End Sub
Private Sub txtreagno_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtReSal.SetFocus
End If

End Sub
Private Sub txtresal_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtCusna.SetFocus
End If

End Sub
Private Sub txtcusna_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtCuId.SetFocus
End If

End Sub
Private Sub txtcuid_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtCuMobi.SetFocus
End If

End Sub
Private Sub txtcumobi_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtSaProN.SetFocus
End If

End Sub
Private Sub txtsapron_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtSaProC.SetFocus
End If

End Sub
Private Sub txtsaproc_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtSaBlk.SetFocus
End If

End Sub
Private Sub txtsablk_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtSaLan.SetFocus
End If

End Sub
Private Sub txtsalan_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtSaSQL.SetFocus
End If

End Sub
Private Sub txtsasql_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtSaPr.SetFocus
End If

End Sub
Private Sub txtsapr_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtReE.SetFocus
End If

End Sub
Private Sub txtree_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtReWe.SetFocus
End If

End Sub
Private Sub txtrewe_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtReNo.SetFocus
End If

End Sub
Private Sub txtreno_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtReSo.SetFocus
End If

End Sub
Private Sub txtreso_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtRecomi.SetFocus
End If

End Sub
Private Sub txtrecomi_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtReAdd.SetFocus
End If

End Sub
Private Sub txtreadd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtReded.SetFocus
End If

End Sub
Private Sub txtreded_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtRePA.SetFocus
End If

End Sub
Private Sub sl()
'txtText2.Text = "ãÈÇÚ"
txtText2.Text = "Test"
End Sub
Private Sub laup()

Dim cnuser As New ADODB.connection
Dim rsupdate As New ADODB.Recordset
Dim reply As String

'Call connection(cnuser, App.Path & "\Medrar.mdb", "endromida")
Call connection(cnuser, "\\mika\medrar\Medrar.mdb", "endromida")
Call Recordset(rsupdate, cnuser, "SELECT l_status,lnum FROM Lands where lnum = ' & txtLaLanum.Text & '")

' reply = rsupdate.Fields!condi

With rsupdate
If .BOF = False And .EOF = True Then
.Fields!l_status = txtText2.Text
.Update
End If
End With

Set cnuser = Nothing
Set rsupdate = Nothing

End Sub
Private Sub lap()

Dim cnuser As New ADODB.connection
Dim rsupdate As New ADODB.Recordset
Dim reply As String

'Call connection(cnuser, App.Path & "\Medrar.mdb", "endromida")
Call connection(cnuser, "\\mika\medrar\Medrar.mdb", "endromida")
Call Recordset(rsupdate, cnuser, "SELECT condi,lannum FROM reser where lannum = ' & txtSaLan.Text & '")

' reply = rsupdate.Fields!c_status

With rsupdate
.Fields!condi = txtText2.Text
' .Update
End With


Set cnuser = Nothing
Set rsupdate = Nothing

End Sub
Private Sub txtre1stid_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call re1st
End If
End Sub
Private Sub txt1stid_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call F1st
End If
End Sub
Private Sub Rdir()
txtReE.Text = "ÍÓÈ ÇáÕß "
txtReWe.Text = " ÍÓÈ ÇáÕß "
txtReNo.Text = " ÍÓÈ ÇáÕß "
txtReSo.Text = " ÍÓÈ ÇáÕß "
End Sub
Private Sub Sdir()
txtEs.Text = " ÍÓÈ ÇáÕß "
txtWs.Text = " ÍÓÈ ÇáÕß "
txtNor.Text = "ÍÓÈ ÇáÕß "
txtSou.Text = " ÍÓÈ ÇáÕß "
End Sub
Function ConvertDateString( _
ByRef StringIn As String, _
ByRef OldCalendar As Integer, _
ByVal NewCalendar As Integer, _
ByRef NewFormat As String) As String

Dim SavedCal As Integer
Dim d As Date
Dim s As String

'// Save VBA Calendar setting to restore when finished
SavedCal = Calendar

'// Convert date to new calendar and format
Calendar = OldCalendar ' Change to StringIn calendar
d = CDate(StringIn) ' Convert from String to Date
Calendar = NewCalendar ' Change to calendar of new string
s = CStr(d) ' Convert to short format String
ConvertDateString = Format(s, NewFormat)

'// Restore VBA Calendar setting
Calendar = SavedCal
End Function
Private Sub Rhij()
Text3.Text = ConvertDateString(txtResDate.Text, 0, 1, "yyyy/mm/dd")
End Sub
Private Sub Shij()
txtText4.Text = ConvertDateString(txtSadate.Text, 0, 1, "yyyy/mm/dd")
End Sub

**DataMiser** · June 2nd, 2012, 01:55 PM

You need to show us the code where you are having an issue. You need to post that code using code tags and with proper formatting so we can read it.

Just posting all your code in a big blob makes it very difficult to help you.

**dongodu** · June 3rd, 2012, 04:03 AM

Updated my previous post, Please need sugesstion.

**DataMiser** · June 3rd, 2012, 10:16 AM

Code:

If .BOF = True And .EOF = True Then
    .Fields!l_status = txtText2.Text
    .Update
     End If
   End With

The problem is still the same as before. You made a change but it was not the one I told you.

When BOF and EOF = true that means there are no records and therefore there is nothing to update. You need to make sure these are not true before you try to update.

See my earlier post.

**dongodu** · June 4th, 2012, 04:26 AM

Code:

Private Sub lap()

 Dim cnuser As New ADODB.connection
  Dim rsupdate As New ADODB.Recordset
  Dim reply As String
  
    'Call connection(cnuser, App.Path & "\Medrar.mdb", "endromida")
    Call connection(cnuser, "\\mika\medrar\Medrar.mdb", "endromida")
    Call Recordset(rsupdate, cnuser, "SELECT condi,lannum FROM reser where lannum = ' & txtSaLan.Text & '")
    
       
         With rsupdate
         If .BOF = False And .EOF = True Then
         .Fields!condi = txtText2.Text
         .Update
         End If
         End With
         
    
Set cnuser = Nothing
Set rsupdate = Nothing

End Sub

*****
After I change like this....its not update exist record sir

Thread: Run Time Error 3201

Thread Tools

Display

Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Re: Run Time Error 3201

Posting Permissions