可以编写 Access VBA 代码以从查询和表单字段插入到表中吗？

Question

I have a simple Activity Attendance Form that has a combo box for use to identify an “Activity” (combo box with a bound table) and an unbound text box to enter the “date” of the Activity.

When a command button (Generate Activity Roster) is executed, a Select Query is run using the Activity Name to filter the list of members who normally attend this activity (from a table: T:ActivityRoster). The results are returned to the Activity Attendance form. The user can then check off the attendance. (I will work on the add/delete members from the Activity Roster later)

My challenge is now to Insert the Query fields (ActivityID, MemberID, Attended, AmtSpent) with the Activity Date into the Table- T:AttendanceHistory.

I have tried unions and other options from the web, but none seem to fit this scenario. Any suggestions would be greatly appreciated.

new code:

 Option Compare Database Option Explicit Private Sub cmdSaveAttRec_Click() Dim actDate As Date, val1 As Long, val2 As Long, val3 As Boolean, val4 As Currency Dim db As DAO.Database, rsIn As DAO.Recordset, rsOut As DAO.Recordset Dim strSQL As String Set db = CurrentDb() strSQL = "SELECT [T:ActivityList].ActivityName, [T:ActivityRoster].ActivityID, [T:ActivityRoster].MemberID, [T:MemberInfo].MemLastNam, [T:MemberInfo].MemFirstNam, [T:MemberInfo].MemMidIni, [T:ActivityRoster].Attended, [T:ActivityRoster].AmtSpent FROM [T:MemberInfo] INNER JOIN ([T:ActivityList] INNER JOIN [T:ActivityRoster] ON [T:ActivityList].ActivityID = [T:ActivityRoster].ActivityID) ON [T:MemberInfo].MemberID = [T:ActivityRoster].MemberID WHERE ((([T:ActivityList].ActivityName)=[Forms]![F:ActivityAttendance]![cboActivityName]))" Set rsIn = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly) Set rsOut = db.OpenRecordset("T:AttendanceHistory", dbOpenDynaset, dbEditAdd) actDate = Me.ActivityDate.Value ' Here you must replace this with the actual control name With rsIn .MoveFirst Do val1 = !ActivityID ' Or the column name of your recordset val2 = !MemberID val3 = !Attended val4 = !AmtSpent With rsOut .AddNew !ActivityDate = actDate !ActivityID = val1 !MemberID = val2 !Attended = val3 !AmtSpent = val4 .Update End With .MoveNext Loop Until .EOF .Close End With End Sub

Answer 1

There are two ways you can acomplish this using VBA:

1. Read the values from the controls and insert them in your table
2. Execute the query directly from VBA, reading the values and insert them into your table

For option 1:

You should add a procedure to your form code:

sub readValuesFromSubForm()
   dim actDate as date, val1 as String
   dim db as DAO.Database, rs as DAO.recordset
   set db = currentDb()
   set rs = db.openrecordset("tbl_output", dbOpenDynaset, dbEditAdd)

   actDate = me.actDate.value  ' Here you must replace this with the actual control name
   ' Read the values from the subform controls:
   val1 = me.subForm.Form.txtVal1.value ' Replace with actual subform and control names

   ' Insert the new row into your table
   with rs
       .addNew
           !actDate = actDate
           !val1 = val1
       .update
       .close
   end with
   db.close
end sub

This only works if there's only one row in the sub form.

For option 2:

sub readValuesFromQuery()
    dim actDate as date, val1 as String
    dim db as DAO.Database, rsIn as DAO.recordset, rsOut as DAO.recordset
    dim strSQL as string
    set db = currentDb()
    strSQL = "select ..." ' Put your query here
    set rsIn = db.openRecordset(strSQL, dbOpenDynaset, dbReadOnly)
    set rsOut = db.openrecordset("tbl_output", dbOpenDynaset, dbEditAdd)
    actDate = me.actDate.value  ' Here you must replace this with the actual control name
    with rsIn
        .moveFirst
        do
           val1 = !val1 ' Or the column name of your recordset
           with rsOut
               .addNew
                   !actDate = actDate
                   !val1 = val1
               .update
           end with
           .moveNext
        loop until .EOF
        .close
    end with
end sub

These are only examples to put you in the right track.

Hope this helps