因子窗体的数据来源,有可能是 表,查询,SQL语句这几种 ,所以非常麻烦,而且子窗体并不一定会显示完表或查询的内容.

我经过摸索,自己写了一个,勉强可以用,但觉得还是不够好,希望能有大师指点 一下.

sub temp()

    Dim rst As Object           'DAO.Recordset or ADODB.Recordset
    Dim ctl As Control
    Dim strItem As String
    Dim blnIsADORecordset As Boolean

  If Me.sfrList.Form.CurrentRecord < 1 Then
        Exit Sub
    End If
    Const errUnsupportedProperty = 438




    Set rst = Me.sfrList.Form.Recordset
    blnIsADORecordset = IsADORecordset(rst)
    strItem1 = ""
    tblname = "tblstock2"
    strWhere = Me.sfrList.Form.Filter   &&是否有筛选
    If InStr(Me.sfrList.Form.RecordSource, "Select") > 0 Then   &&是否SQL语句
        strSQL = Replace(Me.sfrList.Form.RecordSource, "From", "into " & tblname & " From")
        If Nz(strWhere) <> "" Then
           strSQL = Replace(strSQL, "ORDER BY", "where  " & strWhere & " ORDER BY") 
         End If
         Debug.Print strSQL
        DoCmd.RunSQL strSQL
        
    Else   &&如不是SQL语句,表或查询,则扫描子窗体显示的字段
        For Each ctl In Me.sfrList.Form.Controls
        If InStr(ctl.Name, "_Label") = 0 Then   &&如为标签则不提取
            If Len(ctl.ControlSource) > 0 Then
                If Not ctl.ControlSource Like "=*" Then
                    strItem = "[" & ctl.ControlSource & "]"
                    strItem1 = strItem1 & ", " & strItem
                End If
            End If
            End If
NextField:
        Next
              If Nz(strWhere) <> "" Then
               strWhere = "where  " & strWhere
               Else
               strWhere = " "
         End If
        strSQL = "Select " & Right(strItem1, Len(strItem1) - 1) & "into " & tblname & " From " & Me.sfrList.Form.RecordSource & " " & strWhere
        Debug.Print strSQL
         DoCmd.RunSQL strSQL
    End If
    
    
    
ExitHere:
    Set rst = Nothing
    Exit Sub


ErrorHandler:
    Select Case Err.Number
    Case errUnsupportedProperty
        Resume NextField
    Case Else
        MsgBoxEx Err.Description, vbCritical
        Resume ExitHere
    End Select
end sub