Why is it that if the number in the bracket is greater than 1272, the function returns all NA value. While if the number if smaller than 1273, the function works fine.
Set db = OpenDatabase(DBFullName)
Set rs = db.OpenRecordset("SELECT * FROM SGXIO_Database")
Dim arr As Variant
Dim temp As Range
Dim counter As Variant
Dim num As Integer
rs.MoveLast
counter = rs.RecordCount
rs.MoveFirst
'bdd is the function name
bdd = Application.Transpose(rs.GetRows(1272))
Set rs = Nothing
db.Close
Set db = Nothing
Probably because ADO sucks and runs into all sorts of memory limits you wouldn't expect. You could probably solve your problem by chunking it. Just process 1000 records at a time. Use the second parameter for GetRows to tell it where you last left off. http://www.w3schools.com/ado/met_rs_getrows.asp
Related
I searched for this a lot but couldn't fine anything that is usable for MS Access, I found solutions for SQL but the statements that are used are not allowed in access SQL.
So, in MS access 2019 I have a table tbContentList with an Id and ParentID. What I would like is to show all childs/decendants of a specific parent.
My table look like this:
If I want to show all the childs of Id 3, I would like to end up with the result:
Is this possible in MS access queries? It is possible with VBA but I think it's faster to do it with queries. Can anybody help me with this topic please?
the SQL equivalent:
https://www.codeproject.com/Articles/818694/SQL-Queries-to-Manage-Hierarchical-or-Parent-child
(All possible childs)
So, I was able to modify the logic from Gustav and make it suitable for my project. I put the parent result between a delimiter ";". This makes it easier to find the descendants of a specific ContentID in the query. Furthermore I had to handle Null values in the parent column since some of the ContentID are the beginning of the the tree.
Public Function GetParentIDs(ByVal lContentID As Long) As String
Static dbs As DAO.Database
Static tbl As DAO.TableDef
Static rst As DAO.Recordset
Dim strParents As String
If dbs Is Nothing Then
' For testing only.
' Replace with OpenDatabase of backend database file.
Set dbs = CurrentDb
Set tbl = dbs.TableDefs("tbContentList")
Set rst = dbs.OpenRecordset(tbl.Name, dbOpenTable)
End If
With rst
.Index = "PrimaryKey"
Do While lContentID > 0
.Seek "=", lContentID
If Not .NoMatch Then
lContentID = Nz(!ParentID.Value, 0)
If lContentID > 0 Then
strParents = ";" & CStr(lContentID) & strParents
Else
Exit Do
End If
Else
Exit Do
End If
Loop
' Leave recordset open.
' .Close
End With
' Don't terminate static objects.
' Set rst = Nothing
' Set tbl = Nothing
' Set dbs = Nothing
'Return value
If strParents = "" Then
GetParentIDs = ""
Else
GetParentIDs = strParents & ";"
End If
End Function
The query to get all Descendants from a specific ContentID. The 3 if for this example, this could be changed to another value.
SELECT tbContentList.[ContentID], tbContentList.[ParentID], tbContentList.[Item], GetParentIDs([ContentID]) AS Parents
FROM tbContentList
WHERE (((GetParentIDs([ContentID])) Like '*;3;*'));
Thanks for the help and putting me in the right direction.
You have several options. One, however, won't do and that is a recursive query using SQL only; Access can't be fooled and will claim about a circular reference. Your only chance is to create a query resolving a limited number of levels only, say, 8 or 10.
But you can cover the recursive call in a domain aggregate function like DLookup(). This is, however, very slow as DLookup() calling the query will run for each and every record. For more than some dozens of records this will most likely be unacceptable.
The fastest way, for an unlimited number of levels, I've found is to create a lookup function which walks the tree for each record. This can output either the level of the record or a compound key built by the key of the record and all keys above.
As the lookup function will use the same recordset for every call, you can make it static, and (for Jet) you can improve further by using Seek to locate the records.
Here's an example from a similar case which will give you an idea:
Public Function RecursiveLookup(ByVal lngID As Long) As String
Static dbs As DAO.Database
Static tbl As DAO.TableDef
Static rst As DAO.Recordset
Dim lngLevel As Long
Dim strAccount As String
If dbs Is Nothing Then
' For testing only.
' Replace with OpenDatabase of backend database file.
Set dbs = CurrentDb
Set tbl = dbs.TableDefs("tblAccount")
Set rst = dbs.OpenRecordset(tbl.Name, dbOpenTable)
End If
With rst
.Index = "PrimaryKey"
While lngID > 0
.Seek "=", lngID
If Not .NoMatch Then
lngLevel = lngLevel + 1
lngID = !MasterAccountFK.Value
If lngID > 0 Then
strAccount = str(!AccountID) & strAccount
End If
Else
lngID = 0
End If
Wend
' Leave recordset open.
' .Close
End With
' Don't terminate static objects.
' Set rst = Nothing
' Set tbl = Nothing
' Set dbs = Nothing
' Alternative expression for returning the level.
' (Adjust vartype of return value of function.)
' RecursiveLookup = lngLevel ' As Long
RecursiveLookup = strAccount
End Function
This assumes a table with a primary key ID and a foreign (master) key pointing to the parent record - and a top level record (not used) with a visible key (AccountID) of 0.
Now your tree will be nicely shown almost instantaneously using a query like this where Account will be the visible compound key:
SELECT
*, RecursiveLookup([ID]) AS Account
FROM
tblAccount
WHERE
(AccountID > 0)
ORDER BY
RecursiveLookup([ID]);
I'm trying to import data from a SQLight database to EXCEL with vba and here is my code :
Sub Importer_Contrat()
Dim conn As Object, rst As Object
Dim strSQL As String, table_name As String
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' OPEN CONNECTION
conn.Open "DRIVER=SQLite3 ODBC Driver;Database=" & Chemin_BDD & BDD2 & ";"
strSQL = "SELECT * FROM " & Contract_Table
' OPEN RECORDSET]
rst.Open strSQL, conn
' OUTPUT TO WORKSHEET
sh_test_sql.Range("test_paste").CopyFromRecordset rst
rst.Close
End Sub
My data data base has only 3 columns (chrono is Integer, Nom is Text and Date is Integer)
The vba works wells when I request an Integer but each time it is asked to import Data from the column Name which is Text and not Integer it doesn't work.
With the code above I just receive the first colum Chrono in Integer.
What is also very strange is that if i use this code :
strSQL = "SELECT * FROM " & Contract_Table
' OPEN RECORDSET]
rst.Open strSQL, conn
Do While Not rst.EOF
MsgBox rst(1)
rst.MoveNext
Loop
I can see the Text I want to import but it doesn't work with the recorset. Do you know where the problem is coming from ? I need to paste a big table on my Excel sheet and I've been looking the answer for days now.
Thank you in advance !
It seems that, while the data is present in the recordset, the CopyFromRecordset method fails to work. As I have used this method quite a lot against other data sources, I would assume that there is an issue with the ODBC driver.
There are many ways to read the data from a recordset. You can loop over it manually, or you can use the GetRows method to build a 2-dimensional array. This 2-dimensional array has the column as first index and the row as second, both dimensions are 0-based.
The following code uses this method and writes the data into a sheet - only that rows and columns are exchanged. I did a test with Worksheetfunction.Transpose to change this but got a runtime error Type mismatch.
Dim myData
myData = rst.GetRows
Dim r As Range
With ThisWorkbook.Sheets(1)
Set r = .Range(.Cells(1, 1), .Cells(UBound(x, 1) + 1, UBound(x, 2) + 1))
r.Value = x
End With
Thank you for your answer. I also think that there is an issue with the ODBC driver and the function CopyFromRecordset. I have solved my issue with a loop on each value of the sql database and an Array that I paste in my Excel :
ReDim Contract_Array(nb_row - 1, Nb_col_DB_Contracts - 1)
For row_runner = 0 To nb_row - 1
For col_runner = 0 To Nb_col_DB_Contracts - 1
Contract_Array(row_runner, col_runner) = rst(col_runner)
Next col_runner
rst.MoveNext
Next row_runner
sh_test_sql.Range("A1:G2").Value = Contract_Array
Thank you for your help !
As the title suggests I am looking into different ways to store the contents of a query into an array. I have been experimenting with different varieties of doing this, but it seems to be that most of these ways are in correct in their output. This is of course do to my lack of understanding of how this is supposed to be appropriately done, so after a while of experimenting I have decided to ask whats the best approach for this? I will share with you some of my approaches thus far and you can see where my investigation has landed me.
Dim MyArray() As Variant
MyArray = rst.GetRows(rst.RecordCount)
This was ok yet this stored all the information vertically instead of horizontally. Is there a way to flip that? Would that be through the use of ReDim? Or is this due to the fact the rows are getting stored in array dimensions and thus they naturally vertical?
Index = 0
Do While Not rst.EOF
ReDim Preserve MyArray(1, Index)
MyArray(0, Index) = CStr(rst.Fields(0).Value)
'Safety check to make sure the value isn't null (was having problems before)
If rst.Fields(1).Value <> vbNullString Then
MyArray(1, Index) = CStr(rst.Fields(1).Value)
End If
Index = Index + 1
rst.MoveNext
Loop
sheet.Range("a1:ba10000").Value = MyArray
This again stored things vertically, but didnt output the records correctly, and in fact only pull the first two columns of info per record, the rest was output as #N/A#. I think I was closer with my original approach, but decided experimenting might land me somewhere.
Do you peeps have some suggestions or can point me in the right direction?
I think it would be quicker to just dump the results to the sheet using:
Sheet1.Range("A1").CopyFromRecordset rst
And then store the results of that dump (from the range) into an array. If it isn't vertical or horizontal like you like, a quick copy/paste-special transpose will make very quick work of it, before bringing it back into the array.
I'm only suggesting that since it seems like your recordset is rather large (2x10000), so iterating as you are doing is going to be time consuming, where dumping the results to the worksheet, manipulating, and picking them back up should be very very quick.
Update (many years later). Looks like it's possible to dump into an array. Something like:
Dim arr
rst.MoveFirst
arr = rst.GetRows
This would allow for programatic manipulation of the recordset (in the array) before shooting the data out to the workbook.
This should work to answer your Question, albeit 5 years late. Recordset to Array to Worksheet
ReDim Preserve can only be used to resize the upperbound of the last previous dimension. You don't have 1 yet, so no ReDim Preserve.
'Goes on Top
Option Explicit
Option Compare Text
Option Base 1
Public Sub Recordset_to_Array_to_Worksheet()
Dim MyArray() As Variant 'unbound Array with no definite dimensions'
Dim db as DAO.Database
Dim rst as DAO.Recordset
Dim strSQL as String, Fieldname as String
Dim i as Integer, j as Integer, colcnt as Integer, rowcnt as Integer
Dim wb as Workbook
Dim ws as Worksheet
Dim Dest as Range
'------------------------RECORDSET------------------------'
Set db = Opendatabase("URL link") 'or Set db = Currentdb()
strSQL = "SQL Statement Here"
Set rst = db.OpenRecordset(strsQL, dbOpenDynaset)
If rst.recordcount <> 0 then '///Do NOT Use "Do While Not rst.EOF" Can cause Problems///'
colcnt = rst.Fields.Count-1
rowcnt = rst.recordcount
Else
Exit Sub
End IF
'-----------------------------WRITE RECORDSET TO MYARRAY----------------------------'
ReDim MyArray (rowcnt, colcnt) 'Redimension MyArray parameters to fit the SQL returned'
rst.MoveFirst
'Populating Array with Headers from Recordset'
For j = 0 To colcnt
MyArray(0,j) = rst.Fields(j).name
Next
'Populating Array with Record Data
For i = 1 to rowcnt
For j = 0 to colcnt
MyArray(i,j) = rst(j)
Next J
rst.movenext
Next i
'---------------------------------WORKSHEET OUTPUT---------------------------------'
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Insert Worksheet Name")
Set Dest = ws.Range("A1") 'Destination Cell
Dest.Resize(UBound(MyArray, 1) + 1, UBound(MyArray, 2) + 1).value =
Application.Transpose(MyArray) 'Resize (secret sauce)
End Sub
I am trying to delete the records of a table rather than deleting the records of a form. I have the following code, which does not work:
please can someone help.
Private Sub Cmd_X_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsCount As Integer
Dim BizNO As Field
Dim Bank_Role As Field
Dim i, j As Integer
Set db = CurrentDb()
Set rs_date = db.OpenRecordset("TRD_Pricing-In date_REAL")
Set PE_ID = rs_date.Fields("Pricing_Element_ID")
rs_date.MoveLast
rs_dateCount = rs_date.RecordCount
MsgBox (rs_dateCount)
MsgBox (Me.Pricing_Element_ID)
MsgBox (PE_ID.Value)
rs_date.MoveLast
For i = 1 To rs_dateCount
If Me!Pricing_Element_ID = PE_ID Then
rs_date.DELETE
Else
rs_date.MovePrevious
End If
Next i
End Sub
In your for loop you are not comparing the right elements. When you do:
Set PE_ID = rs_date.Fields("Pricing_Element_ID")
you set PE_ID to the value of the Pricing_Element_ID of the first record. You intend to set a reference to it, and everytime the recordset advances to the next record, you want this reference to be updated. But that's not how it works. You have to get the field in the current record every time you advance the recordset. So you have to write:
If Me!Pricing_Element_ID = rs_date.Fields("Pricing_Element_ID") Then
Note: from experience I found the count of a recordset is not always accurate. So rather than a for loop, use a while loop:
While (Not EOF(rs_date))
If Me!Pricing_Element_ID = rs_date.Fields("Pricing_Element_ID") Then
rs_date.DELETE
Else
rs_date.MoveNext
End If
Wend
Note also that there is no need to proces the recordset from last to first; just advance to next until EOF.
If I run a query to select three seperate fields from each record. Is it possible to get the results for each returned in three separate strings (one for each field) so that I can cycle through them in vba code?
Yes, you can try opening a Recordset and accessing the field values like a collection.
Dim d As DAO.Database
Dim r As DAO.Recordset
Set d = CurrentDb()
Set r = d.OpenRecordset("SQL or TableName")
While Not r.EOF
Debug.Print r!Field1, r!Field2, r!Field3
r.MoveNext
Wend
r.Close
Set r = Nothing
Set d = Nothing