I
ina
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
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