将数据从查询插入表时,是否为插入的每个记录运行查询?

我已经编写了一个非常基本的模块,与您当前的流程相比,它应该可以很快地完成这一任务。注意,您需要在项目导航窗格中将项目重新命名为“数据库”以外的其他名称,这样才能正常工作

我假设表1和表2与上面的相同 表3只是表1中所有记录的列表,其中包含要添加的空白“FieldValues”字段 所需的“value1,value2”等。这将导致表3中填入所需的结果

提示:对于使用recordset.edit和.update函数的任何人,请确保在访问选项菜单中删除记录级锁定,该锁定可以在访问选项的“客户端设置”部分找到,否则将导致文件极度膨胀,因为只有在您压缩和修复数据库后,访问才能删除记录锁定。这可能会导致数据库在达到windows的2gb限制后无法恢复。

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

您使用的是一个用户定义函数(UDF)ConcatRelated,因此UDF为每个记录运行,否则,Access SQL通常以正常方式工作。

基于peggity的回答,我的最终代码是:

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