Import Script Failing Sporadically

Question

The script ran fine for a year, then it began failing sporadically.  I suspect it's related to a DB timeout or network issue, but I can't pinpoint the issue.  I added some basic logging and error trapping, but it isn't enough to go on.  Any ideas on how to continue troubleshooting?
Function FDM_JDE_Connect(strLoc, lngCatKey, dblPerKey, strWorkTableName)
' Date         Person         Modification
' 20131024     Jeff McAhren   Cleaned up code, added logging
  Dim cnSS      ' Integration 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
  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 Integration database
  cnSS.open "Provider=SQLOLEDB.1;Password=mypassword;Persist Security Info=True;User ID=myuser;Initial Catalog=mydatabase;Data Source=mydb;"
  WriteLog "Connected to Integration 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.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
  rsAppend.AddNew
  If err <> 0 Then WriteLog "*** ERROR EXECUTING ADDNEW - RECORD: " & r & " - Error: " & err  & " - " & Err.Description
  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
  rsAppend.Update
  If err <> 0 Then WriteLog "*** ERROR EXECUTING UPDATE - RECORD: " & r & " - Error: " & err  & " - " & Err.Description
  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
  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.log", 8, True) '8=ForAppending
    objLogFile.Writeline (Now() & ": " & LogMessage)
    objLogFile.Close
    Set objLogFile = Nothing
End Sub

Answer 1

Oh, and there is this:
** Begin FDM Runtime Error Log Entry [2013-10-28 16:07:18] **
ERROR:
Code............................................. -2147467259
Description...................................... File [07^JDE^Actual^Jul - 2013^RR.txt] Caused Error: (Query timeout expired At line: 99) <=== LINE 99 is the "LOOP" Statement
Procedure........................................ clsBatchLoader.mFileCollectionProcess
Component........................................ upsWBatchLoaderDM
Version.......................................... 1112
Thread........................................... 5844
IDENTIFICATION:
User............................................. sys_jde_load
Computer Name.................................... MyServer
App Name......................................... BBCFDM
Client App....................................... WebClient
CONNECTION:
Provider......................................... SQLOLEDB
Data Server...................................... MyDBServer
Database Name.................................... BBCFDM
Trusted Connect.................................. False
Connect Status.. Connection Open
GLOBALS:
Location......................................... JDE
Location ID...................................... 749
Location Seg..................................... 3
Category......................................... ACTUAL
Category ID...................................... 13
Period........................................... Jul - 2013
Period ID........................................ 7/31/2013
POV Local........................................ False
Language......................................... 1033
User Level....................................... 1
All Partitions................................... True
Is Auditor....................................... False