Passing values to an SQL Server backend database using a form

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,

I am trying to pass values from a form to an SQL Server 2000 DB using the
OpenRecordSet method and then the .AddNew function. Originally my code was
working intermittently, but I kept getting errors saying I need to add
dbSeeChanges to my OpenRecordSet method.

I added dbSeeChanges to my code in the relevant places and now no data at
all is being passed to my SQL DB and I am getting errors complaining about
blank records.

Perhaps someone can look at my code and suggest where I am going wrong or
suggest an easier way to pass values directly from a form into SQL Server
2000.

Here's the code (sorry it's quite long):

Private Sub BtnImportDB_Click()

On Error GoTo Error_Handler

Dim db As Database
Dim recA As DAO.Recordset
Dim recB As DAO.Recordset
Dim recC As DAO.Recordset
Dim KeyA As Integer
Dim KeyB As Integer
Dim IntCounter As Integer 'Used to monitor which tables are updated

Set db = CurrentDb
IntCounter = 0

Set recA = db.OpenRecordset("dbo_AgentDetails", dbOpenDynaset, dbSeeChanges)
With recA
.FindFirst "AgentName = '" & Me!TxtAgntNme & "'" 'Check to see if the
agent details already exist

If .NoMatch Then 'Details don't exist in the SQL db. Update records

.AddNew
!AgentName = Me!TxtAgntNme
!AgentAddress1 = Me!TxtAgntAd1
!AgentAddress2 = Me!TxtAgntAd2
!AgentAddress3 = Me!TxtAgntAd3
!AgentAddress4 = Me!TxtAgntAd4
!AgentAddress5 = Me!TxtAgntAd5
!AgentContactName = Me!TxtAgntCon
!AgentTelNo = Me!TxtAgntTel
!AgentEmail = Me!TxtAgntEmail
!UserLogged = Me!TxtUserNme
.Update

Else

MsgBox "A record already exists for this Partner Agent. Database not
updated", vbInformation, "Information Conflict"
IntCounter = 1
'Inform user records no updated
End If

End With

'requery the recordset to update the values
'recA.Requery
'recA.Close
'Set recA = Nothing

'sets the foreign key value for the Property table
KeyA = DLookup("[AgentKey]", "QrySelectAgent", "[AgentName] =
Forms!FrmRSRInput!TxtAgntNme")

Set recB = db.OpenRecordset("dbo_Property", dbOpenDynaset, dbSeeChanges)
With recB
.FindFirst "PropName = '" & Me!TxtSrvNme & "'" 'Check to see if the
property details exist

If .NoMatch Then
.AddNew
!PropName = Me!TxtSrvNme
!PropAddress1 = Me!TxtSrvAd1
!PropAddress2 = Me!TxtSrvAd2
!PropAddress3 = Me!TxtSrvAd3
!PropAddress4 = Me!TxtSrvAd4
!PropAddress5 = Me!TxtSrvAd5
!UserLogged = Me!TxtUserNme
!AgentKey = KeyA
.Update

Else

MsgBox "A record already exists for this property. Database not
updated", vbInformation, "Information Conflict"

Select Case IntCounter
Case 0
IntCounter = 1
Case 1
IntCounter = 2
End Select

'Inform user records no updated
End If

End With
'recB.Requery
'recB.Close
'Set recB = Nothing

'sets the foreign key value for the RSRData table
KeyB = DLookup("[PropKey]", "QrySelectProperty", "[PropName] =
Forms!FrmRSRInput!TxtSrvNme")

Set recC = db.OpenRecordset("dbo_RSRData", dbOpenDynaset, dbSeeChanges)
With recC
.FindFirst "ReportPeriod = '" & Me!TxtRepPrd & "'" 'Check to see
if the property details exist

If .NoMatch Then
.AddNew
!ReportPeriod = Me!TxtRepPrd
!ColASelf = TxtSelfA
!ColBSelf = TxtSelfB
!ColCSelf = TxtSelfC
!ColAShare = TxtShareA
!ColBShare = TxtShareB
!ColCShare = TxtShareC
!ColE = TxtE
!NumNewLet = TxtNumNewLet
!NumReLet = TxtNumReLet
!LocalAuthNom = TxtNomi
!NumReject = TxtNomRej
!NumRejectStat = TxtStatNomRej
!NumEvcRntArrs = TxtRntArrsEvc
!NumEvcASBODem = TxtASBOEvcDem
!NumEvcASBOOth = TxtASBOEvcOth
!NumEvcOth = TxtOthEvc
!UserLogged = Me!TxtUserNme
!PropKey = KeyB
.Update

Else

.FindFirst "PropKey = " & KeyB

If .NoMatch Then
.AddNew
!ReportPeriod = Me!TxtRepPrd
!ColASelf = TxtSelfA
!ColBSelf = TxtSelfB
!ColCSelf = TxtSelfC
!ColAShare = TxtShareA
!ColBShare = TxtShareB
!ColCShare = TxtShareC
!ColE = TxtE
!NumNewLet = TxtNumNewLet
!NumReLet = TxtNumReLet
!LocalAuthNom = TxtNomi
!NumReject = TxtNomRej
!NumRejectStat = TxtStatNomRej
!NumEvcRntArrs = TxtRntArrsEvc
!NumEvcASBODem = TxtASBOEvcDem
!NumEvcASBOOth = TxtASBOEvcOth
!NumEvcOth = TxtOthEvc
!UserLogged = Me!TxtUserNme
!PropKey = KeyB
.Update

Else
MsgBox "A record already exists for this set of RSR data. Database
not updated", vbInformation, "Information Conflict"

Select Case IntCounter
Case 0
IntCounter = 1
Case 1
IntCounter = 2
Case 2
IntCounter = 3
End Select

End If

End If

End With

'recC.Requery
'recC.Close
'Set recC = Nothing

Select Case IntCounter
Case 0
MsgBox "Update routine complete", vbInformation, "Success"
'Tells the user the routine completed
Case 1
MsgBox "Update routine finished. 1 update did not complete",
vbInformation, "Update Incomplete"
Case 2
MsgBox "Update routine finished. 2 updates did not complete",
vbInformation, "Update Incomplete"
Case 3
MsgBox "Update routine finished. 3 updates did not complete",
vbInformation, "Update Incomplete"
Case Else
MsgBox "A strange error has occured as you shouldn't see this
message!", vbCritical, "Error"
End Select

Exit_Routine:
Exit Sub

Error_Handler:
MsgBox "An error has occured in this application. An email will now be
sent to IT containing the following info: " _
& vbCrLf & "Error Number: " & Err.Number & vbCrLf & "Error Description:
" _
& Err.Description, vbCritical, "Application Error"

DoCmd.SendObject acSendNoObject, , , "(e-mail address removed)", , , "PA
Database Error", _
"An error has occurred in the PA Database and the error description is:
" & Err.Description _
& ". " & "The object causing the error to be invoked is " & Err.Source _
& ". " & "The user who caused the error is: " & Environ("UserName") & ".
", False

Resume Exit_Routine

End Sub
 
Are you using A project database or Access data database with odbc?

Why not using ADO?

simple Insert Example
dim lID as long
dim rs as adodb.recordset
dim cmdGetID as new adodb.command
dim cmdInsert as new adodb.command

cmdGetID.commandtext="SELECT ID FROM MyTable WHERE Name=?"
cmdGetID.Connection=CurrentProject.ActiveConnection
cmdGetID.Parameters.Refresh

cmdInsert.commandtext="INSERT INTO MyTable (Name) VALUES (?)"
cmdInsert.Connection=CurrentProject.ActiveConnection
cmdInsert.Parameters.Refresh

' best to put this in seperate function since you will call it more then
once :-)
lID=0
cmdGetId.Parameters(0)=Value
set rs = cmdGetID.execute
if not rs.eof then
lID=rs(0)
end if
rs.close
if lID=0 then
cmdInsert.Parameters(0)=Value
cmdInsert.Execute
cmdGetId.Parameters(0)=Value
set rs = cmdGetID.execute
if not rs.eof then
lID=rs(0)
end if
rs.close
end if
set rs=nothing
set cmdGetId=nothing
set cmdInsert=nothing

You can even get better results when using Stored Procedures

spMyTable_Insert
(
@Value VARCHAR(100),
@ID INT=0 OUTPUT
)
AS
SET @ID=0
SELECT @ID=ID FROM MyTable WHERE Name=@Value
IF @ID=0
BEGIN
INSERT INTO MyTable (Name) VALUES (@Value)
SET @ID=@@IDENTITY
END



now vba code

dim cmdInsert as new adodb.command

cmdInsert.commandtext="spMyTable_Insert"
cmdInsert.CommandType=adCmdStoredProc
cmdInsert.Connection=CurrentProject.ActiveConnection
cmdInsert.Parameters.Refresh


cmdInsert.Parameters("@Value")=Value
cmdInsert.Execute
debug.print cmdInsert.Parameters("@ID") ' holds the new ID

- Raoul


Enterprise Andy said:
Hi,

I am trying to pass values from a form to an SQL Server 2000 DB using the
OpenRecordSet method and then the .AddNew function. Originally my code was
working intermittently, but I kept getting errors saying I need to add
dbSeeChanges to my OpenRecordSet method.

I added dbSeeChanges to my code in the relevant places and now no data at
all is being passed to my SQL DB and I am getting errors complaining about
blank records.

Perhaps someone can look at my code and suggest where I am going wrong or
suggest an easier way to pass values directly from a form into SQL Server
2000.

Here's the code (sorry it's quite long):

Private Sub BtnImportDB_Click()

On Error GoTo Error_Handler

Dim db As Database
Dim recA As DAO.Recordset
Dim recB As DAO.Recordset
Dim recC As DAO.Recordset
Dim KeyA As Integer
Dim KeyB As Integer
Dim IntCounter As Integer 'Used to monitor which tables are updated

Set db = CurrentDb
IntCounter = 0

Set recA = db.OpenRecordset("dbo_AgentDetails", dbOpenDynaset, dbSeeChanges)
With recA
.FindFirst "AgentName = '" & Me!TxtAgntNme & "'" 'Check to see if the
agent details already exist

If .NoMatch Then 'Details don't exist in the SQL db. Update records

.AddNew
!AgentName = Me!TxtAgntNme
!AgentAddress1 = Me!TxtAgntAd1
!AgentAddress2 = Me!TxtAgntAd2
!AgentAddress3 = Me!TxtAgntAd3
!AgentAddress4 = Me!TxtAgntAd4
!AgentAddress5 = Me!TxtAgntAd5
!AgentContactName = Me!TxtAgntCon
!AgentTelNo = Me!TxtAgntTel
!AgentEmail = Me!TxtAgntEmail
!UserLogged = Me!TxtUserNme
.Update

Else

MsgBox "A record already exists for this Partner Agent. Database not
updated", vbInformation, "Information Conflict"
IntCounter = 1
'Inform user records no updated
End If

End With

'requery the recordset to update the values
'recA.Requery
'recA.Close
'Set recA = Nothing

'sets the foreign key value for the Property table
KeyA = DLookup("[AgentKey]", "QrySelectAgent", "[AgentName] =
Forms!FrmRSRInput!TxtAgntNme")

Set recB = db.OpenRecordset("dbo_Property", dbOpenDynaset, dbSeeChanges)
With recB
.FindFirst "PropName = '" & Me!TxtSrvNme & "'" 'Check to see if the
property details exist

If .NoMatch Then
.AddNew
!PropName = Me!TxtSrvNme
!PropAddress1 = Me!TxtSrvAd1
!PropAddress2 = Me!TxtSrvAd2
!PropAddress3 = Me!TxtSrvAd3
!PropAddress4 = Me!TxtSrvAd4
!PropAddress5 = Me!TxtSrvAd5
!UserLogged = Me!TxtUserNme
!AgentKey = KeyA
.Update

Else

MsgBox "A record already exists for this property. Database not
updated", vbInformation, "Information Conflict"

Select Case IntCounter
Case 0
IntCounter = 1
Case 1
IntCounter = 2
End Select

'Inform user records no updated
End If

End With
'recB.Requery
'recB.Close
'Set recB = Nothing

'sets the foreign key value for the RSRData table
KeyB = DLookup("[PropKey]", "QrySelectProperty", "[PropName] =
Forms!FrmRSRInput!TxtSrvNme")

Set recC = db.OpenRecordset("dbo_RSRData", dbOpenDynaset, dbSeeChanges)
With recC
.FindFirst "ReportPeriod = '" & Me!TxtRepPrd & "'" 'Check to see
if the property details exist

If .NoMatch Then
.AddNew
!ReportPeriod = Me!TxtRepPrd
!ColASelf = TxtSelfA
!ColBSelf = TxtSelfB
!ColCSelf = TxtSelfC
!ColAShare = TxtShareA
!ColBShare = TxtShareB
!ColCShare = TxtShareC
!ColE = TxtE
!NumNewLet = TxtNumNewLet
!NumReLet = TxtNumReLet
!LocalAuthNom = TxtNomi
!NumReject = TxtNomRej
!NumRejectStat = TxtStatNomRej
!NumEvcRntArrs = TxtRntArrsEvc
!NumEvcASBODem = TxtASBOEvcDem
!NumEvcASBOOth = TxtASBOEvcOth
!NumEvcOth = TxtOthEvc
!UserLogged = Me!TxtUserNme
!PropKey = KeyB
.Update

Else

.FindFirst "PropKey = " & KeyB

If .NoMatch Then
.AddNew
!ReportPeriod = Me!TxtRepPrd
!ColASelf = TxtSelfA
!ColBSelf = TxtSelfB
!ColCSelf = TxtSelfC
!ColAShare = TxtShareA
!ColBShare = TxtShareB
!ColCShare = TxtShareC
!ColE = TxtE
!NumNewLet = TxtNumNewLet
!NumReLet = TxtNumReLet
!LocalAuthNom = TxtNomi
!NumReject = TxtNomRej
!NumRejectStat = TxtStatNomRej
!NumEvcRntArrs = TxtRntArrsEvc
!NumEvcASBODem = TxtASBOEvcDem
!NumEvcASBOOth = TxtASBOEvcOth
!NumEvcOth = TxtOthEvc
!UserLogged = Me!TxtUserNme
!PropKey = KeyB
.Update

Else
MsgBox "A record already exists for this set of RSR data. Database
not updated", vbInformation, "Information Conflict"

Select Case IntCounter
Case 0
IntCounter = 1
Case 1
IntCounter = 2
Case 2
IntCounter = 3
End Select

End If

End If

End With

'recC.Requery
'recC.Close
'Set recC = Nothing

Select Case IntCounter
Case 0
MsgBox "Update routine complete", vbInformation, "Success"
'Tells the user the routine completed
Case 1
MsgBox "Update routine finished. 1 update did not complete",
vbInformation, "Update Incomplete"
Case 2
MsgBox "Update routine finished. 2 updates did not complete",
vbInformation, "Update Incomplete"
Case 3
MsgBox "Update routine finished. 3 updates did not complete",
vbInformation, "Update Incomplete"
Case Else
MsgBox "A strange error has occured as you shouldn't see this
message!", vbCritical, "Error"
End Select

Exit_Routine:
Exit Sub

Error_Handler:
MsgBox "An error has occured in this application. An email will now be
sent to IT containing the following info: " _
& vbCrLf & "Error Number: " & Err.Number & vbCrLf & "Error Description:
" _
& Err.Description, vbCritical, "Application Error"

DoCmd.SendObject acSendNoObject, , , "(e-mail address removed)", , , "PA
Database Error", _
"An error has occurred in the PA Database and the error description is:
" & Err.Description _
& ". " & "The object causing the error to be invoked is " & Err.Source _
& ". " & "The user who caused the error is: " & Environ("UserName") & ".
", False

Resume Exit_Routine

End Sub
Click to expand...
 
Back
Top