how to add recordset to database in vb6

[prasadpbr]

HI i Have created a recordset in vb6. I want to add that recordset rows to database table (sql server 2005) i wrote for that. But its not working properly. Can anyone suggest me. below is my code.


frmDNELoad.lblStatus.Caption = "Loading data into database......"
Call FindServerConnection_NoMsg

Dim lngRecCount As Long
lngRecCount = 0
rcdDNE.MoveFirst

With cmdCommand
.ActiveConnection = objConn
.CommandText = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CommandType = adCmdText
End With

Set rcdReclamation = New ADODB.Recordset
With rcdReclamation
.ActiveConnection = objConn
' .Source = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open cmdCommand
End With

Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop

frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh

End Function
Sub CommitNew()

' Add records to DneFrc table
With rcdReclamation
.Requery
.AddNew
.Fields![RTN] = rcdDNE.Fields![RTN]
.Fields![AccountNbr] = rcdDNE.Fields![AccountNbr]
.Fields![FirstName] = rcdDNE.Fields![FirstName]
.Fields![MiddleName] = rcdDNE.Fields![MiddleName]
.Fields![LastName] = rcdDNE.Fields![LastName]
.Fields![Amount] = rcdDNE.Fields![Amount]
.Update
End With

End Sub



********************connection string code ********************


Option Explicit

Public objConn As ADODB.Connection
Public objCommNoParmSP As ADODB.Command
Public objCommSQLText As ADODB.Command
Public objCommCntlNbr As ADODB.Command
Public strDBServer As String

Sub InstantiateConnection()
Set objConn = New ADODB.Connection
objConn.CommandTimeout = 0
objConn.ConnectionTimeout = 60

'Server Connection
objConn.ConnectionString = "Provider=SQLOLEDB.1; Server=" & strDBServer & "; User ID=RS_DNE; Password=welcomers_dne; Initial Catalog=NORS"

objConn.Open
objConn.DefaultDatabase = "NORS"
End Sub

Sub ValidateConnection()
If objConn.State = 0 Then
objConn.Open
End If
End Sub

Sub InstantiateCommand_SP()
' Creates a command object to be used when executing read-only stored
' procedures with NO PARAMETERS.
Set objCommNoParmSP = New ADODB.Command
objCommNoParmSP.ActiveConnection = objConn
objCommNoParmSP.CommandType = adCmdStoredProc
End Sub

Sub InstantiateCommand_SQLText()
' Creates a command object to be used when executing SQL statements.
Set objCommSQLText = New ADODB.Command
objCommSQLText.ActiveConnection = objConn
objCommSQLText.CommandType = adCmdText
End Sub

Function FindServerConnection_NoMsg() As String
'--------------------------------------------------------------------------
' Purpose:
' Gets the listing of possible server connection strings.
' Tries each one until it either succeeds or exhausts the
' list. Then prompts user to manually enter the connection
' string.
' In:
' none.
' Out:
' "" empty string, or valid path.
' Created:
'
' Modified:
'
'--------------------------------------------------------------------------
Dim rcdClientPaths As ADODB.Recordset
Dim strDBTemp As String
Const CLIENT_UPDATE_DIR = "\\PSGSPHX02\NORS\Rs\ClientUpdate\"

On Error Resume Next
' If persisted recordset is not there, try and copy one down from
' CLIENT_UPDATE_DIR. If that can't be found, create a blank one
' and ask the user for the server name.
Set rcdClientPaths = New ADODB.Recordset
' Does it already exist locally?
If FileExists_FullPath(App.Path & "\" & "t_PCD_ServerConnectionList.xml") = False Then
' Can it be retrieved from CLIENT_UPDATE_DIR
If Dir(CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml") <> "" Then
FileCopy CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml", App.Path & "\" & "t_PCD_ServerConnectionList.xml"
Else
' Creat a blank one.
With rcdClientPaths
.Fields.Append "ServerConnection", adVarChar, 250
.Fields.Append "Description", adVarChar, 50
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.Open
.Save App.Path & "\" & "t_PCD_ServerConnectionList.xml", adPersistXML
.Close
End With
End If
End If

' Open the recordset
With rcdClientPaths
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.Open App.Path & "\" & "t_PCD_ServerConnectionList.xml", , , , adCmdFile
End With

If rcdClientPaths.RecordCount <> 0 Then
' try each one listed
rcdClientPaths.MoveFirst
Do Until rcdClientPaths.EOF
strDBTemp = TryConnection_NoMsg(rcdClientPaths.Fields![serverconnection])
If strDBTemp <> "" Then
FindServerConnection_NoMsg = strDBTemp
Exit Function
End If
rcdClientPaths.MoveNext
Loop
strDBTemp = ""
End If

Do While strDBTemp = ""
If strDBTemp <> "" Then
strDBTemp = TryConnection_NoMsg(strDBTemp)
If strDBTemp <> "" Then
With rcdClientPaths
.AddNew
.Fields![serverconnection] = strDBTemp
.Update
.Save
End With
FindServerConnection_NoMsg = strDBTemp
Exit Function
End If
Else
Exit Function
End If
Loop
End Function

Function TryConnection_NoMsg(ByVal SvName As String) As String
On Error GoTo ErrHandle
' If a server was provided, try to open a connection to it.
Screen.MousePointer = vbHourglass
Set objConn = New ADODB.Connection
With objConn
.CommandTimeout = 30
.ConnectionTimeout = 30
.ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
.Open
.Close
End With
Set objConn = Nothing
TryConnection_NoMsg = SvName
Screen.MousePointer = vbNormal
Exit Function

ErrHandle:
TryConnection_NoMsg = ""
Set objConn = Nothing
Screen.MousePointer = vbNormal
Exit Function

End Function

[dglienna]

please read the rules, go back and format your code, and post a question if you have it.

we don't do homework, which is what it looks like