访问VBA运行时错误'3021'没有当前记录 - 将多行连接成一行

Question

对于每个“ConcatID”，我想将“Major”连接成由“;”分隔的一行;

Source table: 
ConcatID Major 
A   Math 
A   English 
A   Theatre 
B   Math 
C   Biology 

Target table: 
A   Math; English; Theatre 
B   Math 
C   Biology 

的代码运行并执行什么，我需要它做的事，但我得到这个错误“运行时错误‘3021’没有当前记录”在这行代码

Do While (ID_prev = rs_source![ConcatID].Value And Not (rs_source.EOF)) 

。

Option Compare Database 
Option Explicit 

Sub Concat() 
    Dim dbs As DAO.Database 

    Dim rs_source As DAO.Recordset 
    Dim rs_target As DAO.Recordset 

    Dim MajorList As String 'Placeholder for concatenating list of college majors 
    Dim ID_prev As String 'Retains ID from previous record 

    Set dbs = CurrentDb 
    Set rs_source = dbs.OpenRecordset("tbl_ConcatMajorsSource") 'many records per student/college 
    Set rs_target = dbs.OpenRecordset("tbl_ConcatMajorsTarget") 'one record per student/college 
    dbs.Execute ("DELETE * FROM tbl_ConcatMajorsTarget") 'clear out table 

    ID_prev = rs_source![ConcatID].Value ' set equal to first ID 
    MajorList = rs_source![Major].Value ' set equal to first major 
    rs_source.MoveNext ' move to the second record 

    Do While Not (rs_source.EOF) 
     Do While (ID_prev = rs_source![ConcatID].Value And Not (rs_source.EOF)) 
      MajorList = rs_source![Major].Value & "; " & MajorList 'concatenate majors 
      rs_source.MoveNext 
     Loop 
     rs_target.AddNew ' add new record in target table 
     rs_target![ConcatID].Value = ID_prev ' populate ID 
     rs_target![Major].Value = MajorList ' populate MajorList 
     rs_target.Update 
     ID_prev = rs_source![ConcatID].Value ' set ID_prev to the new ID 
     MajorList = "" 'blank out MajorList 
    Loop 

    rs_source.Close 
    rs_target.Close 
    Set rs_source = Nothing 
    Set rs_target = Nothing 
End Sub 

预先感谢您！

Answer 1

这是因为记录集到达EOF时无法读取记录。因此：

Do While Not rs_source.EOF 
     If ID_prev = rs_source![ConcatID].Value Then 
      Exit Do 
     Else 
      MajorList = rs_source![Major].Value & "; " & MajorList 'concatenate majors 
      rs_source.MoveNext 
     End If 
    Loop