MSAccess - Select & Insert Into - in chunks? - ms-access

I have a routine that grabs data from a linked SQL Server into a local table:
Set db = CurrentDb()
db.QueryTimeout = 0
...
strSql = "INSERT INTO Item " & _
"SELECT dbo_Item.* " & _
"FROM dbo_Item " & _
"WHERE dbo_Item.MASTER_INVID = " & TempVars!my_InvID
db.Execute strSql
Problem is some of these datasets can be very large (>500K records, ~750MB in size).
I get odd issues with some user due to the potentially LONG fetch process, and possibly some intermittency in their internet connections.
Question: Is it possible/feasible to break this task into chunks? Grabbing blocks of records from the dbo recordset and inserting/appending to my local table. Can I select ~50K blocks of records via a query?
I do know the row_count (via DCount query) in advance, so I could compute the number of chunks, and also show some progress (Chunk 1 of 10...) type message to my users.
Note: Oddity - Usually my users will see an error message, but many times the current fetch method will just give up without complaint and return control to the initiating Form. I have seen myself in my own session.

Here's my approach - leveraging an auto incremented attribute "clientinputid" 1/:
Dim db As Database
Dim intRecordQty As Long
Dim intMin As Long
Dim intMax As Long
Dim intChunk As Long
Dim intCount As Long
Dim intQty As Long
Dim strSql As String
Set db = CurrentDb()
'unrelated code snipped....
intRecordQty = DCount("[dbo_Item.InvID]", "dbo_Item", "[InvID] = " & TempVars!my_InvID)
intMin = DMin("clientinputid", "dbo_Item", "[InvID] = " & TempVars!my_InvID)
intMax = DMax("clientinputid", "dbo_Item", "[InvID] = " & TempVars!my_InvID)
Select Case intRecordQty
Case 0 To 10000
intChunk = (intMax - intMin) / 2
Case 10001 To 25000
intChunk = (intMax - intMin) / 4
Case 25001 To 100000
intChunk = (intMax - intMin) / 10
Case Is > 100001
intChunk = (intMax - intMin) / 100
End Select
intQty = intRecordQty / intChunk
intCount = intMin
Do While intCount < intMax
strSql = "INSERT INTO Item " & _
"SELECT dbo_Item.* " & _
"FROM dbo_Item " & _
"WHERE dbo_Item.clientinputid between " & intCount & " and " & (intCount + intChunk) & " and dbo_Item.MASTER_INVID = " & TempVars!my_InvID
db.Execute strSql
DoEvents
intCount = intCount + intChunk + 1
Loop
'more unrelated code snipped....
1/ - clientinputid is machine-generated as an auto-increment field. There are holes in the range of values, introduced by upstream processes. Seems to be workable, though I do not know if always true for every InvID.

Related

How to get bigdata from one table and insert into another in VBA?

I have table with columns like key,English Phrase and that phrase with other 40 languages.See in following image :
I want to break the records of these table by it's language column like following image:
I did this using the following code:
Sub InsertIntoMasterPhrases()
Dim objRecordsetMaster As ADODB.Recordset
Set objRecordsetMaster = New ADODB.Recordset
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordsetMaster.ActiveConnection = CurrentProject.Connection
objRecordset.ActiveConnection = CurrentProject.Connection
objRecordsetMaster.Open ("SELECT [Master Table].* FROM [Master Table];")
While objRecordsetMaster.EOF = False
objRecordset.Open ("Select [SAP_LANGUAGE to LANG].[LANGUAGE NAME], [SAP_LANGUAGE to LANG].[LANGUAGE] " & _
"From [SAP_LANGUAGE to LANG]")
While objRecordset.EOF = False
key = objRecordsetMaster.Fields("Key").Value
englishPhrase = objRecordsetMaster.Fields("English Phrase").Value
language = objRecordset.Fields("LANGUAGE").Value
translation = objRecordsetMaster.Fields(languageName).Value
If (GetRecordsExist(CStr(key), CStr(englishPhrase), CStr(language)) = "") Then
Query = "INSERT INTO [Language Sample](Key,English,Translation,Language)VALUES ('" & key & "','" & englishPhrase & "','" & translation & "','" & language & "');"
CurrentDb.Execute Query
End If
objRecordset.MoveNext
Wend
objRecordset.Close
objRecordsetMaster.MoveNext
Wend
objRecordsetMaster.Close
End Sub
//Checking records already exist in table
Function GetRecordsExist(key As String, english As String, language As String) As String
Dim db As Database
Dim Lrs As DAO.Recordset
Dim LGST As String
Set db = CurrentDb()
Set Lrs = db.OpenRecordset("SELECT KEY FROM [Language Sample] where KEY='" & key & "' and English='" & english & "' and Language = '" & language & "'")
If Lrs.EOF = False Then
LGST = "Found"
Else
LGST = ""
End If
Lrs.Close
Set Lrs = Nothing
GetRecordsExist = LGST
End Function
In the Master table i have 15000 records and when its breaking 15000 records it becomes 15000 * 40 = 600000. above code inserting almost 10000 records per minutes and after few hour it' hangs up . But also it don't produce any error then i have to restart the access. Kindly help how can i do it in better way.
Alternative 1:
Use a large UNION query to append many records with one SQL statement, as described here:
How to simulate UNPIVOT in Access 2010?
You will probably want to split it into several chunks (e.g. 5 or 10 languages at a time), or Access might choke on the query.
Alternative 2:
Instead of running INSERT statements for each record, use a DAO recordset with .AddNew. This is faster by magnitudes, see this answer:
https://stackoverflow.com/a/33025620/3820271

In VBA Query cannot be completed

I want to find the sum of records from different tables and insert the output in a new column, when I run the code it show me the error:
"The query cannot be completed. Either the size of the query result is
larger than the maximum size of the database (2GB) or there is not enough
temporary storage space on the disk to store the query result"
And it highlight the line
STD.Open sql, cnn, adOpenStatic
My code is the following
Option Compare Database
Option Explicit
Public cnn As New ADODB.Connection
Public db As DAO.Database
Public Sub SMain()
Set db = Access.Application.CurrentDb
Set cnn = CurrentProject.Connection
Get_Value
End Sub
Private Sub Get_Value()
Dim sql As String
Dim STD As New ADODB.Recordset
Dim ODR As DAO.Recordset
Set ODR = db.OpenRecordset("Total_tbl")
Do Until ODR.EOF
DoEvents
sql = "SELECT SUM(MONT_VOL.tot_n* STD_tbl.factor_n)AS TOTAL_N FROM MONT_VOL " & _
" INNER JOIN (STD_tbl INNER JOIN Total_tbl ON STD_tbl.AREA =Total_tbl.AREA_1" & _
" AND STD_tbl.AID = Total_tbl.AID)" & _
" ON MONT_VOL.BID = STD_tbl.BLOCK" & _
" WHERE MONT_VOL.BDATE = Total_tbl.Adate" & _
" GROUP BY MONT_VOL.BID"
STD.Open sql, cnn, adOpenStatic
If STD.RecordCount <> 0 Then
ODR.Edit
ODR!New_Col= STD!TOTAL_N
ODR.Update
End If
STD.Close
ODR.MoveNext
Loop
End Sub
What mistake I did?
And am I calling the output correctly on
ODR!New_Col= STD!TOTAL_N
If the query is too big (which the error message indicates), then let's split it into smaller chunks. This is only properly possible in MySQL, Access doesn't support LIMIT or OFFSET, workarounds are messy, especially for totals queries
I'm making a few assumptions here:
All relevant tables are stored within the same MySQL database
Your tables have valid connection strings that can be used for ADO
Note that executing the query in MySQL alone is probably enough to fix this error.
Private Sub Get_Value()
Dim sql As String
Dim STD As New ADODB.Recordset
Dim ODR As DAO.Recordset
Set ODR = db.OpenRecordset("Total_tbl")
'Create a new ADODB connection that's directly to MySQL, and doesn't use Access
Dim adoConn2 As ADODB.Connection
adoConn2.ConnectionString = CurrentDb.TableDefs("MONT_VOL").Connect
adoConn2.Open
'Initialize variables used for pagination
Dim RecordCount As Integer
Dim PageSize As Integer
Dim Offset As Integer
Offset = 0
RecordCount = 1
PageSize = 100
Do Until ODR.EOF
DoEvents
While RecordCount <> 0
sql = "SELECT SUM(MONT_VOL.tot_n* STD_tbl.factor_n)AS TOTAL_N FROM MONT_VOL " & _
" INNER JOIN (STD_tbl INNER JOIN Total_tbl ON STD_tbl.AREA =Total_tbl.AREA_1" & _
" AND STD_tbl.AID = Total_tbl.AID)" & _
" ON MONT_VOL.BID = STD_tbl.BLOCK" & _
" WHERE MONT_VOL.BDATE = Total_tbl.Adate" & _
" GROUP BY MONT_VOL.BID" & _
" LIMIT " & Offset & "," & PageSize
STD.Open sql, adoConn2, adOpenStatic
RecordCount = STD.RecordCount
If STD.RecordCount <> 0 Then
ODR.Edit
ODR!New_Col = STD!TOTAL_N
ODR.Update
End If
STD.Close
Offset = Offset + PageSize
Wend
ODR.MoveNext
Loop
adoConn2.Close
End Sub

Error on a recordset, but same SQL works elsewhere

Error: "Run-time error '3061' Too few parameters. Expected 2.
I wrote this simple function that returns the remaining percentage calculated for number of records changed. It is supposed to occur when the user updates the field called 'percentage' I am certain the code below should work, but obviously something is wrong. It occurs on the line:
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
I wonder how it could fail when the very same query is what populates the 'record source' for the form with the 'percentage' textbox.
Function RemainingPercentAvailable() As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
Dim CurrentTotal As Single
CurrentTotal = 0
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
CurrentTotal = CurrentTotal + rs!Percentage
rs.MoveNext
Loop
End If
RemainingPercentAvailable = "Remaing available: " & Format(1 - CurrentTotal, "0.000%")
Set rs = Nothing
Set db = Nothing
End Function
Adapt your code to use the SELECT statement with a QueryDef, supply values for the parameters, and then open the recordset from the QueryDef.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Tier1, [Percentage], Tier3 AS Battalion, [Month] " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND (([Month])=[Forms]![frmEntry]![cmbMonth]));"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL )
' supply values for the 2 parameters ...
qdf.Parameters(0).Value = Eval(qdf.Parameters(0).Name)
qdf.Parameters(1).Value = Eval(qdf.Parameters(1).Name)
Set rs = qdf.OpenRecordset
Note: Month is a reserved word. Although that name apparently caused no problems before, I enclosed it in square brackets so the db engine can not confuse the field name with the Month function. It may be an unneeded precaution here, but it's difficult to predict exactly when reserved words will create problems. Actually, it's better to avoid them entirely if possible.
This one is calling a query directly in a DAO.Recordset and it works just fine.
Note the same 'Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) This is a parameter SQL as well.
The only difference is with this one is that I DIDN'T need to move through and analyze the recordset - but the error occurs on the 'Set rs = " line, so I wasn't able to get further anyway.
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
strSQL = "SELECT Sum(tbl_SP.AFP) AS AFP_TOTAL, tbl_SP.T1_UNIT " _
& "FROM tbl_SP " _
& "GROUP BY tbl_SP.T1_UNIT " _
& "HAVING (((tbl_SP.T1_UNIT)='" & strUnit & "'));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
AFP_Total = rs!AFP_Total
There is an even simpler way to calculate the total percentage.
Instead of looping through the records, you can use the DSum() function.
Note that DSum will return Null if there are no records, so you need to wrap it in Nz().
Just for fun, here is your function but written as one single statement:
Function RemainingPercentAvailable() As String
RemainingPercentAvailable = "Remaining available: " & Format(1 - _
Nz(DSum("Percentage", _
"tbl_CustomPercent", _
"Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth))) _
, "0.000%")
End Function
I don't recommend building a temporary parameterized query in VBA, because it makes the code too complicated. And slower. I prefer to build "pure" SQL that will run directly in the db engine without any callbacks to Access. I'm assuming that your function is defined in the frmEntry form, and that cmbImport_T1 and cmbMonth are string fields. If they are numeric, omit qString().
Here is my version of your function. It handles the empty-recordset case correctly.
Function RemainingPercentAvailable() As String
Dim CurrentTotal As Double, q As String
q = "SELECT Percentage" & _
" FROM tbl_CustomPercent" & _
" WHERE Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth)
CurrentTotal = 0
With CurrentDb.OpenRecordset(q)
While Not .EOF
CurrentTotal = CurrentTotal + .Fields("Percentage")
.MoveNext
Wend
End With
RemainingPercentAvailable = "Remaining available: " & _
Format(1 - CurrentTotal, "0.000%")
End Function
' Return string S quoted, with quotes escaped, for building SQL.
Public Function QString(ByVal S As String) As String
QString = "'" & Replace(S, "'", "''") & "'"
End Function

Access 2007 VBA Record Set Infinite Loop

So I am doing a query that when you click a button it takes a record set with an unassigned field of data and copies that recordset into the same table with a new "assigned version".
I want my database to be able to make different/multiple "assigned versions" from the original unassigned set, and this works great when i create the first assigned set, but when i try to create a new assigned set it goes into a loop that seems completely random, it could create new entries from 10-1000 and i dont know what is causing this.
Sorry if this was confusing, looking at the code will probably help more
thanks!
Dim rs1 As DAO.Recordset
Dim unionquery As String
Dim CURRENT_SOFTWARE_VERSION As String
CURRENT_SOFTWARE_VERSION = Me.Parent.[Software Version].Value
initialquery = "select [Test Script] , [PROC_CHECK_ID], [Software Version] from (FORMAL_CERT_PROCEDURE_TEST_SCRIPTS inner join FORMAL_CERT_PROCEDURE_CHECK on FORMAL_CERT_PROCEDURE_TEST_SCRIPTS.TEST_CASE_ID = FORMAL_CERT_PROCEDURE_CHECK.TEST_CASE_ID) inner join FORMAL_CERT_SOFTWARE_VERSION on FORMAL_CERT_PROCEDURE_TEST_SCRIPTS.TEST_CASE_ID = FORMAL_CERT_SOFTWARE_VERSION.TEST_CASE_ID where PROC_CHECK_ID=" & Me.PROC_CHECK_ID & " AND [Software Version]=""" & CURRENT_SOFTWARE_VERSION & """ "
Set rs1 = CurrentDb.OpenRecordset(initialquery, dbOpenForwardOnly)
Do Until rs1.EOF = True
Dim rs2 As DAO.Recordset
Set rs2 = CurrentDb.OpenRecordset( _
"SELECT * FROM FORMAL_CERT_PROCEDURE_TEST_SCRIPTS", _
dbOpenDynaset)
rs2.AddNew
rs2![Test Script] = rs1![Test Script]
rs2![PROC_CHECK_ID_FK] = rs1!PROC_CHECK_ID
rs2![Software_Version] = rs1![Software Version].Value
rs2![TEST_CASE_ID] = Me.TEST_CASE_ID
rs2.Update
rs2.Close
Set rs2 = Nothing
rs1.MoveNext
Loop
Oh dear.
If you add records into the table you are currently iterating through, you will have problems in reaching EOF, since you are not only iterating through what you started with, but also the new records that you just added.
The solution is to separate the loop and the insert into discrete steps: loop through and save the values you want to insert, then insert after the loop is finished.
Assuming the values are string, numeric, string, numeric:
Set rs1 = CurrentDb.OpenRecordset(initialquery, dbOpenForwardOnly)
dim strQuery() as String
dim intCounter as Long
dim recordCount as Long
intCounter = 0
rs1.MoveLast
recordCount = rs1.RecordCount
Redim strQuery(0 to recordCount)
rs1.MoveFirst
strQuery(0) = "INSERT INTO FORMAL_CERT_PROCEDURE_TEST_SCRIPTS ([Test Script],[PROC_CHECK_ID_FK],[Software_Version],[TEST_CASE_ID]) VALUES "
Do Until rs1.EOF = True
intCounter = intCounter + 1
strQuery(intCounter) = strQuery(0) & " ('" & rs1![Test Script] & "'," & _
& rs1!PROC_CHECK_ID & "," & _
& "'" & rs1![Software Version].Value & "'," & _
& Me.TEST_CASE_ID & ")"
rs1.MoveNext
Loop
For intCounter = 0 To recordCount
CurrentDb.Execute(strQuery(intCounter))
Next
This will avoid the issue of the EOF pointer moving further away as you insert.
Edit: I forgot you can't do multiple inserts with default DBA, I changed the code to reflect that.

In Access find a random record (true random)

what I'm trying to do is everytime the program opens the image on a form is different. So I have a simple table with 2 columns ID and ImagePath, how do I create the code so a random record(ImagePath) is chosen, on a form load event or something similar? Rnd is no good, as it will be the same image everytime the database is reopened.
Thanks!
Try calling Randomize once -- before the first time you call Rnd. As, the help topic for Rnd says, "Before calling Rnd, use the Randomize statement without an argument to initialize the random-number generator with a seed based on the system timer."
Rnd is no good?
Option Compare Database
Option Explicit
Sub Test()
Randomize
Dim x As Integer
'Print the first field of a 100 random records
For x = 0 To 100
CallRandomRecord
Next x
End Sub
Sub CallRandomRecord()
Dim rs As DAO.Recordset
Dim recordCount As Long
Dim randomRecord As Long
Set rs = CurrentDb.OpenRecordset("SELECT * FROM MyTable")
rs.MoveLast 'To get the count
rs.MoveFirst
recordCount = rs.recordCount - 1
randomRecord = CLng((recordCount) * Rnd)
rs.Move randomRecord
Debug.Print "Random Record No:" & randomRecord & " Field 1: " & rs.Fields(0)
End Sub
I wrote a couple functions of my own to return a random record and then timed them along with the other solutions offered here. Both of mine beat the Harkins method, but neither of them could touch #ray023's (slightly modified for benchmarking) solution. #ray023's solution is also arguably the simplest. Take that Susan Harkins!
Here's the code. You can copy it and paste into a standard module to test on your data. You just need to change the three constants at the top of the TimeThem module:
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub TimeThem()
Const Loops As Integer = 10
Const TblName As String = "Batches"
Const FldName As String = "BatchName"
Const IndexFld As String = "BatchID"
Dim i As Integer, s As Long, dummy As Variant
s = GetTickCount
For i = 1 To Loops
dummy = HarkinsRandom(TblName, FldName)
Next i
Debug.Print "Harkins:"; GetTickCount - s
s = GetTickCount
For i = 1 To Loops
dummy = RandomRecord(TblName, FldName)
Next i
Debug.Print "RandomRecord:"; GetTickCount - s
s = GetTickCount
For i = 1 To Loops
dummy = RandomRecordWithIndex(TblName, FldName, IndexFld)
Next i
Debug.Print "WithIndex:"; GetTickCount - s
s = GetTickCount
For i = 1 To Loops
dummy = CallRandomRecord(TblName, FldName)
Next i
Debug.Print "CallRandom:"; GetTickCount - s
End Sub
Function HarkinsRandom(TblName As String, FldName As String)
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset(" SELECT TOP 1 " & FldName & _
" FROM " & TblName & _
" ORDER BY GetRandomValue(" & FldName & ")", _
dbOpenForwardOnly)
HarkinsRandom = rs(0)
End Function
Public Function GetRandomValue(fld As Variant)
Randomize
GetRandomValue = Rnd(1)
End Function
Function RandomRecord(TblName As String, FldName As String)
Dim NumRecs As Long, RecNum As Long
Dim SQL As String, SubSQL As String, rs As DAO.Recordset
Dim IndexFld As String
Randomize
NumRecs = CurrentDb.OpenRecordset("SELECT Count(*) FROM " & TblName, dbOpenForwardOnly)(0)
RecNum = Int(Rnd() * NumRecs + 1)
SQL = " SELECT TOP 1 " & FldName & _
" FROM (" & _
" SELECT TOP " & RecNum & " " & FldName & " " & _
" FROM " & TblName & _
" ORDER BY " & FldName & ")" & _
" ORDER BY " & FldName & " DESC"
Set rs = CurrentDb.OpenRecordset(SQL, dbOpenForwardOnly)
RandomRecord = rs(0)
End Function
Function RandomRecordWithIndex(TblName As String, FldName As String, _
Optional IndexedFieldName As String)
Dim NumRecs As Long, RecNum As Long
Dim SQL As String, SubSQL As String, rs As DAO.Recordset
Dim IndexFld As String
Randomize
NumRecs = CurrentDb.OpenRecordset("SELECT Count(*) FROM " & TblName, dbOpenForwardOnly)(0)
RecNum = Int(Rnd() * NumRecs + 1)
If Len(IndexedFieldName) = 0 Or IndexedFieldName = FldName Then
SQL = " SELECT TOP 1 " & FldName & _
" FROM (" & _
" SELECT TOP " & RecNum & " " & FldName & " " & _
" FROM " & TblName & _
" ORDER BY " & FldName & ")" & _
" ORDER BY " & FldName & " DESC"
Else
SQL = " SELECT TOP 1 " & FldName & _
" FROM (" & _
" SELECT TOP " & RecNum & " " & FldName & ", " & IndexedFieldName & _
" FROM " & TblName & _
" ORDER BY " & IndexedFieldName & ")" & _
" ORDER BY " & IndexedFieldName & " DESC"
End If
Set rs = CurrentDb.OpenRecordset(SQL, dbOpenForwardOnly)
RandomRecordWithIndex = rs(0)
End Function
Function CallRandomRecord(TblName As String, FldName As String)
Dim rs As DAO.Recordset
Dim recordCount As Long
Dim RandomRecord As Long
Set rs = CurrentDb.OpenRecordset("SELECT " & FldName & " FROM " & TblName)
rs.MoveLast 'To get the count
rs.MoveFirst
recordCount = rs.recordCount - 1
RandomRecord = CLng((recordCount) * Rnd)
rs.Move RandomRecord
CallRandomRecord = rs(0)
' Debug.Print "Random Record No:" & randomRecord & " Field 1: " & rs.Fields(0)
End Function
And here are the results of the test running against a table with about 50,000 records (it's a locally linked Jet table; ie, it's in an .mdb on the same computer as where I ran the test):
Harkins: 4461
RandomRecord: 2528
WithIndex: 1918
CallRandom: 172
Harkins: 4150
RandomRecord: 2278
WithIndex: 2043
CallRandom: 47
CallRandom: 63
WithIndex: 2090
RandomRecord: 2324
Harkins: 4197
CallRandom: 46
WithIndex: 1997
RandomRecord: 2169
Harkins: 4150
I ran it four times reversing the order after the first two to account for potential caching advantages. As you can see, my two functions ran about twice as fast as the Harkins solution, but #ray023's solution was at its slowest more than 25 times faster (and at its fastest nearly 100 times faster).
But by all means, benchmark against your own data.
See this article by Susan Harkins on TechRepublic: http://www.techrepublic.com/blog/howdoi/how-do-i-retrieve-a-random-set-of-records-in-microsoft-access/149
I used her GetRandomValue function in this query, which returns a different record each time.
SELECT TOP 1 f.id, GetRandomValue(f.id) AS rnd_value
FROM tblFoo AS f
ORDER BY 2;
The function:
Public Function GetRandomValue(fld As Variant)
Randomize
GetRandomValue = Rnd(1)
End Function
Caution: This approach requires running a function against every row of the table. It may be tolerable for small to medium tables. But you should not use it with very large tables.
I may be too simple to understand the problem, but it seems to me that if you want to retrieve a single random image, then all you need to do is generate a single random number that somehow keys into the table of images available to you. If there are 100 images to choose from, you want a random number from 1 to 100.
So, you generate that number:
Round(100 * Rnd(), 0)
...and then you use that to retrieve the image. If the table of images has an Autonumber PK, you could just use that, and it would be VERY FAST. If your image is in a subform, you could set the LinkMaster to the literal PK value and that would retrieve the image for you.
On the subject of Randomize(), I can't seem to get it to repeat when I call Rnd() in the Immediate window, so I'm not sure if it's needed.
But it all seems like a very simple operation to me, one that may not require any SQL or the use of a recordset. If you go the recordset route, I'd recommend opening it once and persisting it and then navigating it each time you need it, rather than opening it repeatedly each time you need a new image. But if I were doing this, I'd make things as simple for myself as possible and go the Autonumber PK route for the images. If you wanted to do it in SQL, that would be:
SELECT Images.ID, Images.Path
FROM Images
WHERE Images.ID = Round(100 * Rnd(), 0)
Obvoiusly, you'd change 100 to an appropriate number. If you need Randomize(), then replace the direct Round(100 * Rnd(), 0) with a function that calls Randomize() and then returns Round(100 * Rnd(), 0).
But maybe I'm missing some important details that makes this much more complicated than I seem to think it is.