I'm inserting data problematically into tables. When I do this from another table, it's swift, only slowed very slightly if there are a lot of records. Even then, it's a matter of seconds.
When I insert from a query to a table, it goes into minutes - roughly a minute for every 1,000 records inserted.
The source query itself, when just run as a select query, takes maybe 1 - 2 seconds. Is the query running for every record that's inserted? I'd hoped that it would run once for the whole data set. Or is there something else that's causing the function to run so slowly when compared to inserting "flat" data from another table.
The VBA I'm using is fairly innocuous:
CurrentDb.Execute "SELECT [Extra Value Concatenation].* _
INTO [" & strTableName & "] FROM [Extra Value Concatenation];"
and the source query is below - it uses Allen Browne's Concatenate function.
SELECT [Extra Fields - Fee Protection Insurance Concatenate].ContactID,
ConcatRelated('[Fee Protection Insurance]',
'[Extra Fields - Fee Protection Insurance Concatenate]',
'ContactID = ' & [ContactID])
AS [Fee Protection Insurance]
FROM [Extra Fields - Fee Protection Insurance Concatenate];
EDIT: In answer to Fionnuala's comment, but I couldn't format it properly in the comments.
Using fictional data, here's roughly what I want.
T1 contains client records.
ContactID Name
1 Example Limited
2 Another Company Limited
T2 contains extra fields. ContactID is there as a foreign key, and may be duplicated if multiple records are held.
ContactID FieldValue
1 Value 1
1 Value 2
2 Value 3
2 Value 4
2 Value 5
When I left join the tables, the duplicates from T2 show up, so I get
ContactID Name FieldValue
1 Example Limited Value 1
1 Example Limited Value 2
2 Another Company Limited Value 3
2 Another Company Limited Value 4
2 Another Company Limited Value 5
when what I want is
ContactID Name FieldValue
1 Example Limited Value 1; Value 2
2 Another Company Limited Value 3; Value 4; Value 5
Hence concatenating the data in a temporary table seemed like a good idea, but is slowing everything down. Is there another way I should be looking at my query?
You are using a user defined function (UDF) ConcatRelated, so the UDF runs for each record, otherwise, usually Access SQL works in the normal way.
I have written a pretty basic module that should accomplish this for you very quickly compared to your current process. Note you will need to re-name your project to something other than "Database" on the project navigation pane for this to work
I have assumed that table1 and table2 are the same as you have above table3 is simply a list of all records in table 1 with a blank "FieldValues" field to add the required "value1, value2" etc. This should result in Table3 being populated with your desired result
IMPORANT: For anyone using recordset .edit and .update functions make sure you remove record level locking in the access options menu, it can be found under the "client settings" section of Access options, failing to do so will cause extreme bloating of your file as access will not drop record locks until you compact and repair the database. This may cause your database to become un-recoverable once it hits the 2gb limit for windows.
Function addValueField()
'Declarations
Dim db As Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim qry As String
Dim value As String
Dim recordcount as Long
Set db = CurrentDb()
'Open a select query that is a join of table 1 and table 2
'I have made Contact ID a foreign key in the second table
qry = "SELECT Table1.[Contact ID], Table1.Name, Table2.FieldValue FROM Table1 INNER JOIN Table2 ON Table1.[Contact ID] = Table2.[Contact ID(FK)] ORDER BY [Contact ID];"
Set rs1 = db.OpenRecordset(qry, dbOpenDynaset)
'Table 3 was filled with each record from table1, with a 3rd "Field Value" field to
'be filled with your Value 1, Value 2 etc.
qry = "SELECT * FROM Table3 ORDER BY [Contact ID]"
Set rs2 = db.OpenRecordset(qry, dbOpenDynaset)
'Ensure you have enough file locks to process records
recordcount = rs1.recordcount
DAO.DBEngine.SetOption DAO.dbMaxLocksPerFile, recordcount + 1000
rs1.MoveFirst
rs2.MoveFirst
'Here we test to see if "Name" is the same in both recordsets, if it is, add the FieldValue
'to the FieldValue in Table3, otherwise move to the next record in table 3 and compare again
Do While Not rs1.EOF
If IsNull(rs2![FieldValue]) = True Then
If rs2![FieldValue] = "" Then
rs2.Edit
rs2![FieldValue] = rs1![FieldValue]
rs2.Update
rs1.MoveNext
Else
rs2.Edit
rs2![FieldValue] = rs2![FieldValue] & "; " & rs1![FieldValue]
rs2.Update
rs1.MoveNext
End If
Else
rs2.MoveNext
End If
Loop
rs1.close
rs2.close
db.close
set db = nothing
set rs1 = nothing
set rs2 = nothing
End Function
Building on pegicity's answer, my eventual code was:
Option Compare Database
Sub Concatenate(strTableToConcatenate As String, strFieldToConcatenate As String, strIDField As String)
Dim rsSource As DAO.Recordset
Dim rsDestination As DAO.Recordset
Dim qry As String
Dim strSourceTable As String
Dim i As Integer
Dim strFieldName As String
Dim strValue As String
Dim intConcatenateID As Integer
Dim intSortID As Integer
strSourceTable = strTableToConcatenate & " (Concatenate)" 'Creates a duplicate copy of the table to be concatenated and empties the original table'
DeleteTable (strSourceTable)
DoCmd.CopyObject , strSourceTable, acTable, strTableToConcatenate
qry = "DELETE FROM [" & strTableToConcatenate & "]"
CurrentDb.Execute (qry)
qry = "ALTER TABLE [" & strTableToConcatenate & "] ALTER COLUMN [" & strFieldToConcatenate & "] memo" 'Changes the DataType of the field to be concatenated to Memo, as the result may be considerably longer than the original data'
CurrentDb.Execute (qry)
i = 0
intCurrentID = 0
qry = "SELECT * FROM [" & strSourceTable & "] ORDER BY [" & strIDField & "], [" & strFieldToConcatenate & "]"
Set rsSource = CurrentDb.OpenRecordset(qry, dbOpenDynaset)
qry = "SELECT * FROM [" & strTableToConcatenate & "]"
Set rsDestination = CurrentDb.OpenRecordset(qry, dbOpenDynaset)
For Each fld In rsSource.Fields 'Finds the column number of the fields you are sorting by and concatenating from your source table.'
strFieldName = rsSource.Fields(i).Name
If strFieldName = strFieldToConcatenate Then
intConcatenateID = i
ElseIf strFieldName = strIDField Then
intSortID = i
End If
i = i + 1
Next
If rsSource.recordcount <> 0 Then
rsSource.MoveFirst
intCurrentID = rsSource.Fields(intSortID).Value
strConcatenateValue = ""
While Not rsSource.EOF 'The source recordset is sorted by your designated sort field, so any duplicates of that field will be next to each other. If the row below has the same id as the row above, the sub continues to build the concatenated value. If the row changes, it adds the concatenated value to the destination record set.'
If intCurrentID = rsSource.Fields(intSortID).Value Then
strConcatenateValue = strConcatenateValue & "," & rsSource.Fields(intConcatenateID).Value
rsSource.MoveNext
Else
rsDestination.AddNew
i = 0
If Len(strConcatenateValue) > 0 Then
strConcatenateValue = Right(strConcatenateValue, Len(strConcatenateValue) - 1)
End If
For Each fld In rsSource.Fields
strFieldName = rsSource.Fields(i).Name
If strFieldName = strFieldToConcatenate Then
strValue = strConcatenateValue
ElseIf strFieldName = strIDField Then
strValue = intCurrentID
Else
strValue = rsSource.Fields(i).Value
End If
rsDestination.Fields(strFieldName) = "" & strValue & ""
i = i + 1
Next
rsDestination.Update
intCurrentID = rsSource.Fields(intSortID).Value
strConcatenateValue = ""
End If
Wend
End If
rsSource.Close
rsDestination.Close
Set rsSource = Nothing
Set rsDestination = Nothing
End Sub
来源：https://stackoverflow.com/questions/21758073/when-inserting-data-from-a-query-to-a-table-does-the-query-run-for-each-record