Error -2147217887 (Multiple-step OLE DB operation generated errors.) message

[kskinne]

I am receiving the following error message when trying to run some code:

"Error -2147217887 (Multiple-step OLE DB operation generated errors.) Check each OLE DB status value, if available. No work was done.)"

Here is my code:

Option Explicit
Private Sub Query_Acct_Balances()
On Error GoTo Query_Acct_Balances_Error
Dim sh As Worksheet
Dim test As String
Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Sheets
  sh.Unprotect Password:="h0tp0int"
  Dim LastRow, i, j As Long
  Dim MyYear As Integer
  Dim glbSQLPart1, glbSQLPart2, glbSQLPart3, glbSQLPart4, glbSQLPart5, glbSQLPart6, glbSQLPart7, glbSQLPart8, glbSQLPart9, glbSQLPart10, glbSQLPart11, glbSQLPart12, glbSQLPart13, glbSQLPart14, glbSQLPart15 As String
  Dim CoStr, AcctIDStr, TypeStr, glbConn1, glbSQLStr1 As String
  Dim glbADOConn1 As ADODB.Connection, glbRecSet As ADODB.Recordset
  MyYear = Year(sh.[A1].Value)
  Set glbADOConn1 = New ADODB.Connection
  glbConn1 = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=breda;Data Source=OSS"
  glbADOConn1.Open glbConn1
  LastRow = sh.[A65536].End(xlUp).Row
  For i = 7 To LastRow
    If sh.Cells(i, 2).Value = "Total Billed" Or sh.Cells(i, 2).Value = "AJE" Or sh.Cells(i, 2).Value = "Ending A/R" Or sh.Cells(i, 2).Value = "" Then
    Else
      If sh.Cells(i, 16).Value <> sh.[A6].Value Then
        Select Case sh.Cells(i, 16).Value
          Case "01"
            CoStr = "breda.dbo.tblgl"
          Case "02"
            CoStr = "prairie.dbo.tblgl"
          Case "03"
            CoStr = "BTC.dbo.tblgl"
          Case "04"
            CoStr = "teleservices.dbo.tblgl"
          Case "06"
            CoStr = "westside.dbo.tblgl"
          Case Else
        End Select
      Else
        Select Case sh.[A6].Value
          Case "01"
            CoStr = "breda.dbo.tblgl"
          Case "02"
            CoStr = "prairie.dbo.tblgl"
          Case "03"
            CoStr = "BTC.dbo.tblgl"
          Case "04"
            CoStr = "teleservices.dbo.tblgl"
          Case "06"
            CoStr = "westside.dbo.tblgl"
          Case Else
        End Select
      End If
      Set glbRecSet = New ADODB.Recordset
      AcctIDStr = sh.Cells(i, 1).Value
      TypeStr = sh.Cells(i, 2).Value
      glbSQLPart1 = "select sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-01-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-01-31 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Jan', "
      Dim yr As Long
      yr = Year(Now)
      Dim eomonth As Integer
      eomonth = Val(Format(Application.WorksheetFunction.eomonth("2/1/" & yr, 0), "dd"))
      glbSQLPart2 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-02-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-02-" & eomonth & " 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Feb', "
      glbSQLPart3 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-03-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-03-31 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Mar', "
      glbSQLPart4 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-04-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-04-30 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Apr', "
      glbSQLPart5 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-05-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-05-31 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'May', "
      glbSQLPart6 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-06-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-06-30 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Jun', "
      glbSQLPart7 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-07-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-07-31 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Jul', "
      glbSQLPart8 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-08-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-08-31 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Aug', "
      glbSQLPart9 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-09-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-09-30 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Sep', "
      glbSQLPart10 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-10-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-10-31 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Oct', "
      glbSQLPart11 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-11-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-11-30 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Nov', "
      glbSQLPart12 = "sum(case when (" & CoStr & ".dtmdate >= '" & MyYear & "-12-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-12-31 23:59:59.000') then " & CoStr & ".dbldebit - " & CoStr & ".dblcredit else 0 end) as 'Dec' "
      glbSQLPart13 = "from " & CoStr & " where " & CoStr & ".straccountid = '" & AcctIDStr & "' and " & CoStr & ".strdescription like '%" & TypeStr & "%' and (" & CoStr & ".dtmdate >= '" & MyYear & "-01-01 00:00:00.000' and " & CoStr & ".dtmdate <= '" & MyYear & "-12-31 23:59:59.000') "
      glbSQLPart14 = "and " & CoStr & ".dbldebit - " & CoStr & ".dblcredit <> 0"
      If sh.Cells(i, 16).Value <> sh.[A6].Value Then
        glbSQLPart15 = " and " & CoStr & ".strorigincompanycode = " & sh.[A6].Value
      Else
        glbSQLPart15 = " and " & CoStr & ".strorigincompanycode IS NULL"
      End If
      glbSQLStr1 = glbSQLPart1 & glbSQLPart2 & glbSQLPart3 & glbSQLPart4 & glbSQLPart5 & glbSQLPart6 & glbSQLPart7 & glbSQLPart8 & glbSQLPart9 & glbSQLPart10 & glbSQLPart11 & glbSQLPart12 & glbSQLPart13 & glbSQLPart14 & glbSQLPart15
      test = InputBox("", "", glbSQLStr1)
      glbRecSet.Open glbSQLStr1, glbADOConn1, adOpenDynamic, adLockReadOnly
      glbRecSet.MoveFirst
      For j = 1 To 12
        If IsNull(glbRecSet.Fields(j - 1).Value) Then
          sh.Cells(i, j + 2).Value = 0
        Else
          If sh.Cells(i, 1).Value = "1180.00000" Or sh.Cells(i, 1).Value = "0142.00000" Then
            sh.Cells(i, j + 2).Value = Round(glbRecSet.Fields(j - 1).Value, 2)
          Else
            sh.Cells(i, j + 2).Value = -Round(glbRecSet.Fields(j - 1).Value, 2)
          End If
        End If
      Next
      Set glbRecSet = Nothing
    End If
  Next
  Set glbADOConn1 = Nothing
  sh.Protect Password:="h0tp0int"
Next
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub
Query_Acct_Balances_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Query_Acct_Balances of Module Module1 - error on Line " & Erl
End Sub

Appears to be erroring out when attempting to open a recordset. This code ran fine as recently as last month. Any idea what is causing this?

Thank you,
Kevin

 

[kskinne]

I actually determined the problem with my code - the date generated by my code, for the month of February, was using the last date in February for 2020 (a leap year, so 29) and the year 2019, so it was a date of 2/29/2019, which of course that date does not exist. This was creating out of range error in SQL when trying to open the recordset because it didn't know what to do with that incorrect date. Fixed the date in the code and the run time error went away.

Thank you,
Kevin