how to add recordset to database in vb6
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 2 of 2

Thread: how to add recordset to database in vb6

  1. #1
    Join Date
    Nov 2009
    Posts
    1

    how to add recordset to database in vb6

    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

  2. #2
    Join Date
    Jan 2006
    Location
    Chicago, IL
    Posts
    14,990

    Re: how to add recordset to database in vb6

    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
    David

    CodeGuru Article: Bound Controls are Evil-VB6
    2013 Samples: MS CODE Samples

    CodeGuru Reviewer
    2006 Dell CSP
    2006, 2007 & 2008 MVP Visual Basic
    If your question has been answered satisfactorily, and it has been helpful, then, please, Rate this Post!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center