Connection Recordset Loop Problem with VBA - Help
 

Hello All,

I have these function.

'This function allows to have a connection
Private Function GetDBConnection(ByRef cndb As ADODB.Connection) As
Boolean

Dim cndb As ADODB.Connection, cndb1 As ADODB.Connection
On Error GoTo GetDBConnection_Err
If cndb Is Notthing Then

cndb.ConnectionString = DATABASECONNECTION
cndb.Open

End If

GetDBConnection = True

Exit Function

GetDBConnection_Err:

GetDBConnection = False

End Function


'This sub allows to close the connection
Private Sub CloseDBConnection(ByRef cndb As ADODB.Connection)

On Error Resume Next

If Not cndb Is Nothing Then
If CBool(cndb.State) = True Then
cndb.Close
Set cndb = Nothing
End If

End Sub


'this function allows to open a recordset
Private Function GetDBRecordSet(ByVal cndb As ADODB.Connection, ByVal
strSQL As String) As ADODB.Recordset
On Error GoTo GetDBRecordSet_Err

Set GetDBRecordSet = New ADODB.Recordset

With GetDBRecorset
.ActiveConnection = cndb
.Open strSQL
End With

Exit Function

GetDBRecordSet = Nothing


End Function

'this sub allows to close the recorset
Private Sub CloseDBRecorSet(rs As ADODB.Recordset)
On Error Resume Next

If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If

End Sub


'this function is the map function between the GetDBRecordSet and
GetRoom
Private Function GetDBRoomQuotes(ByVal cndb As ADODB.Connection,
strRoomCode As String) As ADODB.Recordset
On Error Resume Next

Dim strSQL As String
Dim strRoomCode as String

strSQL = "SELECT * FROM ROOM" 'my query
Set GetDBRoom = GetDBRecordSet(cndb, strSQL)

End Function


'HERE I HAVE A PROBLEM WITH MY LOOP
'This is the function GetRoom as argument strRoomCode as String and
Return a tbl as variant
Public Function GetRoom(ByVal strRoomCode As String) as Variant
On Error GoTo GetRoom_Err

Dim cndb As ADODB.Connection 'database connection
Dim rsRoomCode As ADODB.Recordset ' Recordset
Dim r As Integer 'row counter
Dim strRoomCode As String 'RoomCode coming from
my query
Dim strName as String 'Name
Dim var(1,5) As String
Dim NextCell as Range

Set rsRoomCode = New ADODB.Recordset
StrName = "September"

'Attempts to connect to database. In case of failure exit the function
If Not GetDBConnection(cndb) Then GoTo Info_Err

'Open recordset that contains the list of indexes
Set rsRoomCode = GetDBRoom(cndb, strRoomCode)

'Extract the list of RoomCode
GetRoom = rsRoomCode(strRoomCode)


r = 2

'I loop my recordset for all item in the list and I build my array
Do While Not rsRoomCode.EOF

'assign to my variable strRoomCode the value number 1; for the code
strRoomCode = rsRoomCode.Fields(1).Value


var(r, 1) = strtRoomCode
var(r, 2) = strName
var(r, 3) = ""
var(r, 4) = ""

r = r + 1

rsAssetRoom.MoveNext

Loop

Dim rngNextCell As Range
Set rngNextCell = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

'Resize the range to set the vartbl
rngNextCell.Resize(UBound(var, 1) - LBound(var, 1) + 1, UBound(var, 2)
- LBound(var, 2) + 1).Value = var


'call the function
GetRoom = var

call CloseDBRecordSet(rsRoomCode)

GetRoom_Err:
GetRoom = CVErr(xlErrNA)


End Function

I really do not know how to do this loop; I tried in several way but I
guess I do something wrong; any help would be very appreciate

Thank you

Ina

Connection Recordset Loop Problem with VBA - Help
 

Apart from the fact that I do not understand what the problem is (your loop
seems ok to me), I think is not very much linked to Excel. i would post this
to a VB Discussion in order to target a more appropriate audience.
--
Stefano Gatto


"ina" wrote:

Hello All,

I have these function.

'This function allows to have a connection
Private Function GetDBConnection(ByRef cndb As ADODB.Connection) As
Boolean

Dim cndb As ADODB.Connection, cndb1 As ADODB.Connection
On Error GoTo GetDBConnection_Err
If cndb Is Notthing Then

cndb.ConnectionString = DATABASECONNECTION
cndb.Open

End If

GetDBConnection = True

Exit Function

GetDBConnection_Err:

GetDBConnection = False

End Function


'This sub allows to close the connection
Private Sub CloseDBConnection(ByRef cndb As ADODB.Connection)

On Error Resume Next

If Not cndb Is Nothing Then
If CBool(cndb.State) = True Then
cndb.Close
Set cndb = Nothing
End If

End Sub


'this function allows to open a recordset
Private Function GetDBRecordSet(ByVal cndb As ADODB.Connection, ByVal
strSQL As String) As ADODB.Recordset
On Error GoTo GetDBRecordSet_Err

Set GetDBRecordSet = New ADODB.Recordset

With GetDBRecorset
.ActiveConnection = cndb
.Open strSQL
End With

Exit Function

GetDBRecordSet = Nothing


End Function

'this sub allows to close the recorset
Private Sub CloseDBRecorSet(rs As ADODB.Recordset)
On Error Resume Next

If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If

End Sub


'this function is the map function between the GetDBRecordSet and
GetRoom
Private Function GetDBRoomQuotes(ByVal cndb As ADODB.Connection,
strRoomCode As String) As ADODB.Recordset
On Error Resume Next

Dim strSQL As String
Dim strRoomCode as String

strSQL = "SELECT * FROM ROOM" 'my query
Set GetDBRoom = GetDBRecordSet(cndb, strSQL)

End Function


'HERE I HAVE A PROBLEM WITH MY LOOP
'This is the function GetRoom as argument strRoomCode as String and
Return a tbl as variant
Public Function GetRoom(ByVal strRoomCode As String) as Variant
On Error GoTo GetRoom_Err

Dim cndb As ADODB.Connection 'database connection
Dim rsRoomCode As ADODB.Recordset ' Recordset
Dim r As Integer 'row counter
Dim strRoomCode As String 'RoomCode coming from
my query
Dim strName as String 'Name
Dim var(1,5) As String
Dim NextCell as Range

Set rsRoomCode = New ADODB.Recordset
StrName = "September"

'Attempts to connect to database. In case of failure exit the function
If Not GetDBConnection(cndb) Then GoTo Info_Err

'Open recordset that contains the list of indexes
Set rsRoomCode = GetDBRoom(cndb, strRoomCode)

'Extract the list of RoomCode
GetRoom = rsRoomCode(strRoomCode)


r = 2

'I loop my recordset for all item in the list and I build my array
Do While Not rsRoomCode.EOF

'assign to my variable strRoomCode the value number 1; for the code
strRoomCode = rsRoomCode.Fields(1).Value


var(r, 1) = strtRoomCode
var(r, 2) = strName
var(r, 3) = ""
var(r, 4) = ""

r = r + 1

rsAssetRoom.MoveNext

Loop

Dim rngNextCell As Range
Set rngNextCell = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

'Resize the range to set the vartbl
rngNextCell.Resize(UBound(var, 1) - LBound(var, 1) + 1, UBound(var, 2)
- LBound(var, 2) + 1).Value = var


'call the function
GetRoom = var

call CloseDBRecordSet(rsRoomCode)

GetRoom_Err:
GetRoom = CVErr(xlErrNA)


End Function

I really do not know how to do this loop; I tried in several way but I
guess I do something wrong; any help would be very appreciate

Thank you

Ina

Connection Recordset Loop Problem with VBA - Help
 

thank you for your answer :), My problem was the recordset. However,I
found the solution, I have create another function calling a connection
and everything it is ok, now.

Ina