Hi,
I have a function in VBA 2008 which returns the results of a query within the requested date range. This query works beautifully if I remove the where statement. Otherwise, I receive the error "Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record." The date is originally in datetime format which is why I use the convert statement. The code is below.
Thanks for your help
Function analyses()
Dim QueryString As String
Dim numrows As Long, i As Long, j As Long
Dim RDMNAME As String, queryresults()
RDMNAME = "RMS SYSTEM RDM"
SConn = "DSN=" & RDMNAME
RDMNAME = Range("RDMNAME")
QueryString = "SELECT ID,NAME,RUNDATE,DESCRIPTION,PERIL FROM " & _
RDMNAME & ".DBO.RDM_ANALYSIS " & _
" WHERE CONVERT(VARCHAR,RUNDATE,103) BETWEEN CONVERT(VARCHAR," & Range("MA_START") & _
",103) AND CONVERT(VARCHAR," & Range("MA_END") & ",103)" & _
" ORDER BY RUNDATE DESC;"
queryresults = SQL_to_Array(SConn, QueryString)
numrows = UBound(queryresults, 2) + 1
Sheets("Input Information").Select
Dim temparray(), therange2 As Range
ReDim temparray(1 To numrows, 1 To 5)
Range("I4").Activate
Set therange2 = ActiveCell.Range(Cells(1, 1), Cells(numrows, 5))
For i = 1 To 5
For j = 1 To numrows
temparray(j, i) = queryresults(i - 1, j - 1)
Next j
Next i
therange2.Value = temparray
End Function
Function SQL_to_Array(SConn As String, QueryString As String)
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim i As Long
Dim DataArray As Variant, errarray()
ReDim errarray(1 To 1, 1 To 1)
On Error GoTo SQL_Err
Set Cn = New ADODB.Connection
Cn.Open SConn
Set Rs = New ADODB.Recordset
Rs.ActiveConnection = Cn
Application.Cursor = xlDefault
Application.StatusBar = "Obtaining data..."
Rs.Open QueryString, Cn, adOpenStatic
Rs.MoveNext
Rs.MoveFirst
DataArray = Rs.GetRows(Rs.RecordCount)
SQL_to_Array = DataArray
Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
SQL_End:
Exit Function
SQL_Err:
For i = 1 To 1
errarray(i, i) = 0
Next i
DataArray = errarray
SQL_to_Array = DataArray
MsgBox Err.Description
GoTo SQL_End
Resume
End Function
I have a function in VBA 2008 which returns the results of a query within the requested date range. This query works beautifully if I remove the where statement. Otherwise, I receive the error "Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record." The date is originally in datetime format which is why I use the convert statement. The code is below.
Thanks for your help
Function analyses()
Dim QueryString As String
Dim numrows As Long, i As Long, j As Long
Dim RDMNAME As String, queryresults()
RDMNAME = "RMS SYSTEM RDM"
SConn = "DSN=" & RDMNAME
RDMNAME = Range("RDMNAME")
QueryString = "SELECT ID,NAME,RUNDATE,DESCRIPTION,PERIL FROM " & _
RDMNAME & ".DBO.RDM_ANALYSIS " & _
" WHERE CONVERT(VARCHAR,RUNDATE,103) BETWEEN CONVERT(VARCHAR," & Range("MA_START") & _
",103) AND CONVERT(VARCHAR," & Range("MA_END") & ",103)" & _
" ORDER BY RUNDATE DESC;"
queryresults = SQL_to_Array(SConn, QueryString)
numrows = UBound(queryresults, 2) + 1
Sheets("Input Information").Select
Dim temparray(), therange2 As Range
ReDim temparray(1 To numrows, 1 To 5)
Range("I4").Activate
Set therange2 = ActiveCell.Range(Cells(1, 1), Cells(numrows, 5))
For i = 1 To 5
For j = 1 To numrows
temparray(j, i) = queryresults(i - 1, j - 1)
Next j
Next i
therange2.Value = temparray
End Function
Function SQL_to_Array(SConn As String, QueryString As String)
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim i As Long
Dim DataArray As Variant, errarray()
ReDim errarray(1 To 1, 1 To 1)
On Error GoTo SQL_Err
Set Cn = New ADODB.Connection
Cn.Open SConn
Set Rs = New ADODB.Recordset
Rs.ActiveConnection = Cn
Application.Cursor = xlDefault
Application.StatusBar = "Obtaining data..."
Rs.Open QueryString, Cn, adOpenStatic
Rs.MoveNext
Rs.MoveFirst
DataArray = Rs.GetRows(Rs.RecordCount)
SQL_to_Array = DataArray
Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
SQL_End:
Exit Function
SQL_Err:
For i = 1 To 1
errarray(i, i) = 0
Next i
DataArray = errarray
SQL_to_Array = DataArray
MsgBox Err.Description
GoTo SQL_End
Resume
End Function