Results 1 to 1 of 1
  1. #1
    Join Date
    Nov 2013
    Posts
    1

    Unanswered: ADO code in VBScript suddenly started failing

    The code below suddenly began to fail sporadically. I don't believe that anything changed on the app server or database server, and I'm really stuck troubleshooting. Can anyone give any ideas of what to look at?

    This VBScript function is invoked every (x) hours by a scheduler in a packaged application. It moves data from a view in one SQL Server 2008 database to a table in another database on the same server.

    It fails about half of the time. There appears to be no pattern to when it fails. There is no pattern regarding what record it fails on. The loop always starts fine, and it always moves some records. It might fail at ~10% of the records, or it might make it to ~90% of the records. I believe that the speed at which the records are moved is the same whether the process is successful, or if it fails (it takes about 10 seconds per 10,000 records), so it's not like it's running slow before it hangs.

    The servers are idle when this runs, I don't think it's a resource or contention issue. The network is up and fast. Everything about the database is fine (space, etc.). The data is being moved to a worker table (staging), and that table is cleared every time, so I don't think this has to do with issues related to table size or indexes.

    The error is "-2147467259 Query timeout expired.", and it's raised on the "rs.MoveNext" line.

    The source view returns ~75,000 records, and takes ~10 seconds to complete in SQL Server Management Studio. I've run a SELECT * FROM (the view) immediately after the script fails, and it returns the expected 75,000 records in the expected 10 seconds.

    I've tried the default cursor type, and the code below shows forcing a client side cursor. This made no difference.

    Function FDM_JDE_Connect(strLoc, lngCatKey, dblPerKey, strWorkTableName)

    Dim cnSS ' EA Connection
    Dim strSQL ' SQL statement for V_HFM_LOAD
    Dim rs ' v_HFM_LOAD Recordset
    Dim rsAppend ' tTB table append rs object
    Dim strMonth
    Dim strYear
    Dim strJDEMonthCol
    Dim r

    On Error Resume Next

    WriteLog "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~"
    WriteLog "FDM_JDE_Connect Starting"
    WriteLog "strLoc = " & strLoc
    WriteLog "lngCatKey = " & lngCatKey
    WriteLog "dblPerKey = " & dblPerKey
    WriteLog "strWorkTableName = " & strWorkTableName

    Set cnSS = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    Set rsAppend = DW.DataAccess.farsTableAppend(strWorkTableName)

    'Connect to the EA database
    cnSS.open "Provider=SQLOLEDB.1;Password=MyPass;Persist Security Info=True;User ID=MyUser;Initial Catalog=EA;Data Source=MyServer;"
    WriteLog "Connected to EA Database; Err = " & Err & " - " & Err.Description

    strMonth = RIGHT("0" & Month(RES.PstrPer),2)
    strJDEMonthCol="GBAN" & strMonth
    strYear = Year(RES.PstrPer)

    strSQL = "SELECT DATAVIEW, YEAR, PERIOD, ENTITY, ACCOUNT, CUSTOM1, CUSTOM2, CUSTOM3, CUSTOM4, AMOUNT " &_
    "FROM V_HFM_LOAD WHERE PERIOD = " & strMonth & " and (YEAR = " & strYear & " or YEAR = '')"

    rs.CursorType = 3 'adOpenStatic
    rs.CursorLocation = 3 'adUseClient
    rs.LockType = 1 'adLockReadOnly
    rs.Open strSQL, cnSS
    WriteLog "rs recordset opened; Err = " & Err & " - " & Err.Description


    'Check for data
    If rs.bof And rs.eof Then
    RES.PlngActionType = 2
    RES.PstrActionValue = "No Records to load!"
    WriteLog "No records to load, exiting function; Err = " & Err & " - " & Err.Description
    Exit Function
    End If

    'Loop through records and append to tTB table in location's DB, use records returned from the strSQL query
    If Not rs.bof And Not rs.eof Then
    WriteLog "Entering do/while loop; Err = " & Err & " - " & Err.Description
    Do While Not rs.eof
    r = r + 1
    If r < 2 Then WriteLog "Add New Record - Starting: " & r
    rsAppend.AddNew
    ' If err <> 0 Then WriteLog "*** ERROR EXECUTING ADDNEW - RECORD: " & r & " - Error: " & err & " - " & Err.Description
    If r < 2 Then WriteLog "Add New Record - Complete: " & r
    If r < 2 Then WriteLog "Set Field Values - Starting: " & r
    rsAppend.Fields("PartitionKey") = RES.PlngLocKey
    rsAppend.Fields("CatKey") = RES.PlngCatKey
    rsAppend.Fields("PeriodKey") = RES.PdtePerKey
    rsAppend.Fields("DataView") = rs.fields("DATAVIEW").Value
    rsAppend.Fields("CalcAcctType") = 9
    rsAppend.Fields("Amount") = rs.fields("AMOUNT").Value
    rsAppend.Fields("Desc1") = rs.fields("ACCOUNT").Value
    rsAppend.Fields("Account") = rs.fields("ACCOUNT").Value
    rsAppend.Fields("Entity") = rs.fields("ENTITY").Value
    rsAppend.Fields("ICP") = "[ICP None]"
    rsAppend.Fields("UD1") = rs.fields("CUSTOM1").Value
    rsAppend.Fields("UD2") = rs.fields("CUSTOM2").Value
    rsAppend.Fields("UD3") = rs.fields("CUSTOM3").Value
    rsAppend.Fields("UD4") = rs.fields("CUSTOM4").Value
    If r < 2 Then WriteLog "Set Field Values - Complete: " & r
    If r < 2 Then WriteLog "Update Record - Starting: " & r
    rsAppend.Update
    If err <> 0 Then WriteLog "*** ERROR EXECUTING UPDATE - RECORD: " & r & " - Error: " & err & " - " & Err.Description
    If r < 2 Then WriteLog "Update Record - Complete: " & r
    If r / 10000 = Int(r / 10000) Then WriteLog "Status Update Record: " & r
    rs.MoveNext
    If err <> 0 Then WriteLog "*** ERROR EXECUTING MOVENEXT - RECORD: " & r & " - Error: " & err & " - " & Err.Description
    Loop
    WriteLog "Exiting do/while loop; recordcount = " & r & "; Err = " & Err & " - " & Err.Description
    End If

    'Close Record Sets
    rs.close
    rsAppend.close

    WriteLog "Recordsets closed, exiting function; Err = " & Err & " - " & Err.Description


    'Assign Return value
    FDM_JDE_Connect = True

    End Function


    Sub WriteLog(LogMessage)
    Dim objLogFile
    Dim FSO
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objLogFile = fso.OpenTextFile("d:\scripts\HFM\FDM_JDE_Connect.l og", 8, True) '8=ForAppending
    objLogFile.Writeline (Now() & ": " & LogMessage)
    objLogFile.Close
    Set objLogFile = Nothing
    End Sub



    Last edited by wooderson; 11-07-13 at 13:48.

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
  •