Updating Data

  • I am trying to write an Active X script. If the data

    already exists in the database, the data will be updated

    from the import file. If not, a new record will be added.

    The code is below, and it executes, but no data is

    imported into the database. Could someone tell me what I

    am doing wrong?

    Function Main()

    Dim objXMLDOM

    Dim objNodes

    Dim objBookNode

    Dim objADORS

    Dim objADOCnn

    Dim prikey,keytest

    Const adOpenKeyset = 1

    Const adLockOptimistic = 3

    Set objXMLDOM = CreateObject("MSXML2.DOMDocument.4.0")

    objXMLDOM.async = False

    objXMLDOM.validateOnParse = False

    'No error handling done

    objXMLDOM.load "c:\books.xml"

    Set objNodes = objXMLDOM.selectNodes("/Books/Book")

    Set objADOCnn = CreateObject("ADODB.Connection")

    Set objADORS = CreateObject("ADODB.Recordset")

    objADOCnn.Open "PROVIDER=SQLOLEDB;SERVER=.;UID=sa;PWD=pass

    word;DATABASE=NorthWind;"

    objADORS.Open "SELECT * FROM tblBooks", objADOCnn,

    adOpenKeyset, adLockOptimistic

    For Each objBookNode In objNodes

    With objADORS

    prikey =

    objBookNode.selectSingleNode("Book_ID").nodeTypedValue

    Do While Not objADORS.EOF

    If prikey = objADORS("Row_ID")

    then

    keytest = "true"

    .fields("Publisher") =

    objBookNode.selectSingleNode("Publisher").nodeTypedValue

    .fields("DateOfPurchase") =

    objBookNode.selectSingleNode

    ("DateOfPurchase").nodeTypedValue

    .fields("BookTitle") =

    objBookNode.selectSingleNode("Title").nodeTypedValue

    .Update

    End if

    objADORS.move 1

    Loop

    If keytest <>"true" then

    .addNew

    .fields("Publisher") =

    objBookNode.selectSingleNode("Publisher").nodeTypedValue

    .fields("DateOfPurchase") =

    objBookNode.selectSingleNode

    ("DateOfPurchase").nodeTypedValue

    .fields("BookTitle") =

    objBookNode.selectSingleNode("Title").nodeTypedValue

    .Update

    End if

    End With

    Next

    objADORS.Close

    objADOCnn.Close

    Main = DTSTaskExecResult_Success

    End Function

  • I notice that your loop is  before the last keytest check (keytest <> "true". Wouldn't you want that to be after the end if instead?

  • I think you are right. I made the change, but now when I execute the package, it seems to run an infinite loop and data keeps getting imported into my database.

    Monica

     

  • Can you post your new code?  

  • Here is the new code...

    Monica

    Function Main()

    Dim objXMLDOM

    Dim objNodes

    Dim objBookNode

    Dim objADORS

    Dim objADOCnn

    Dim prikey,keytest

    Const adOpenKeyset = 1

    Const adLockOptimistic = 3

    Set objXMLDOM = CreateObject("MSXML2.DOMDocument.4.0")

    objXMLDOM.async = False

    objXMLDOM.validateOnParse = False

    'No error handling done

    objXMLDOM.load "c:\books.xml"

    Set objNodes = objXMLDOM.selectNodes("/Books/Book")

    Set objADOCnn = CreateObject("ADODB.Connection")

    Set objADORS = CreateObject("ADODB.Recordset")

    objADOCnn.Open "PROVIDER=SQLOLEDB;SERVER=.;UID=sa;PWD=pass

    word;DATABASE=NorthWind;"

    objADORS.Open "SELECT * FROM tblBooks", objADOCnn,

    adOpenKeyset, adLockOptimistic

    For Each objBookNode In objNodes

    With objADORS

    prikey =

    objBookNode.selectSingleNode("Book_ID").nodeTypedValue

    Do While Not objADORS.EOF

    If prikey = objADORS("Row_ID")

    then

    keytest = "true"

    .fields("Publisher") =

    objBookNode.selectSingleNode("Publisher").nodeTypedValue

    .fields("DateOfPurchase") =

    objBookNode.selectSingleNode

    ("DateOfPurchase").nodeTypedValue

    .fields("BookTitle") =

    objBookNode.selectSingleNode("Title").nodeTypedValue

    .Update

    End if

    objADORS.move 1

    If keytest <>"true" then

    .addNew

    .fields("Publisher") =

    objBookNode.selectSingleNode("Publisher").nodeTypedValue

    .fields("DateOfPurchase") =

    objBookNode.selectSingleNode

    ("DateOfPurchase").nodeTypedValue

    .fields("BookTitle") =

    objBookNode.selectSingleNode("Title").nodeTypedValue

    .Update

    End if                                                                                               Loop

    End With

    Next

    objADORS.Close

    objADOCnn.Close

    Main = DTSTaskExecResult_Success

    End Function

  • I think your non-exiting loop is caused by you using the same recordset to update as well as add new.  You could test this by creating a new recordset just for the addnew portion and .update and .close it.

     

     

  • Hello,

    1. Regarding your current code, I don*t see the the closure for the loop: Do While Not objADORS.EOF

    2. However, I'd approach it a bit differently -- here's how I handled this in my ASP page. First, I define one more recordset:

        Dim rsSelected 

      

    3. Then I wrote the loop like this:

          For Each objBookNode In objNodes

            prikey = objBookNode.selectSingleNode("Book_ID").nodeTypedValue

            objADORS.Filter = "Row_ID=""" & prikey & """"

            Set rsSelected = objADORS.OpenRecordset '' Find correct entry, else: empty RS

            With rsSelected

              If .RecordCount = 0 Then

                .AddNew

                .fields("Row_ID") = prikey

              Else

                '' DAO would need this: .Edit -- For ADO you don't need anything.

              End If

             .fields("Publisher") = objBookNode.selectSingleNode("Publisher").nodeTypedValue

             .fields("DateOfPurchase") = objBookNode.selectSingleNode("DateOfPurchase").nodeTypedValue

             .fields("BookTitle") = objBookNode.selectSingleNode("Title").nodeTypedValue

             .Update

            End With

          Next

    Good luck.


    Regards,

    Bob Monahon

  • Bob,

    I tried implementing your code and got the following error:

    Error Source: Provider

    Error Description: Error Code:0

    Error Source = Provider

    Error Description Type Mismatch

    Error on Line 36

    Type mismatch

    Line 36 is:

    objADORS.Filter = "Row_ID=""" & prikey & """"

    Monica

     

     

     

Viewing 8 posts - 1 through 7 (of 7 total)

You must be logged in to reply to this topic. Login to reply