请教个导出子窗体记录的方法

导出EXCEL
'=========================================================================================
'函数名称： ExportToExcel
'功能描述： 导出数据到Excel
'输入参数： WorkbookName     必需的，工作簿名称
'           FirstRange       必须的，粘贴时定位的单元格（默认为A1单元格）
'返回参数： 无
'使用说明： 由于采用的复制粘贴数据的方法，所以如果要导出子窗体数据，必须先让子窗体获得焦点
'           如果是导出主窗体数据，则主窗体中的焦点控件不能是子窗体，必须先将焦点从子窗体移开
'例子：me.frmchild.setfocus
      ExportToExcel “导出数据”
'作    者： 红尘如烟
'创建日期： 20011-4-1
'=========================================================================================
Function ExportToExcel(WorkbookName As String, Optional FirstRange As String = "A1")
    On Error GoTo Err_ExportToExcel3
    Dim objExcel As Object
    Dim objBook As Object
    Dim strFileName As String
    Dim strExtName As String
    Dim blnHasData As Boolean

    Const xlExcel8 = 56
    Const xlNormal = -4142

    '优先判断当前焦点控件是否子窗体，如果是则复制其中数据
    '其次如果当前不是子窗体或子窗体没有记录源，则再判断当前活动窗体
    If TypeOf Screen.ActiveForm.ActiveControl Is SubForm Then
        If Len(Screen.ActiveForm.ActiveControl.Form.RecordSource) > 0 Then
            blnHasData = True
        End If
    Else
        If Len(Screen.ActiveForm.RecordSource) > 0 Then blnHasData = True
    End If

    If Not blnHasData Then Exit Function

    '根据当前版本取得对应的文件扩展名
    strExtName = ".xls"
    '    If Val(Application.Version) > 11 Then strExtName = ".xlsx"

    '取得另存为文件名
    With Application.FileDialog(2)    'msoFileDialogSaveAs
        .InitialFileName = WorkbookName & strExtName
        If Not .Show Then Exit Function
        strFileName = .SelectedItems(1)
        If Not strFileName Like "*" & strExtName Then
            strFileName = strFileName & strExtName
        End If
        If Len(Dir(strFileName)) > 0 Then Kill strFileName
    End With
    '选择所有记录，然后调用复制命令复制到剪切板
    RunCommand acCmdSelectAllRecords
    RunCommand acCmdCopy
    '发送TAB击键，以取消全选状态
    DoEvents
    SendKeys "{TAB}", True
    '    Me.Toolbar1.SetFocus
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    Set objBook = objExcel.Workbooks().add()
    objBook.Worksheets.add().Select
    objBook.Worksheets(1).Name = WorkbookName
    objExcel.Range(FirstRange).Select
    objExcel.ActiveSheet.Paste
    '    objExcel.Selection.Interior.ColorIndex = -4142 'xlNone
    objExcel.Range(FirstRange).Select
    If Val(objExcel.Version) > 11 Then
        objBook.SaveAs strFileName, xlExcel8
    Else
        objBook.SaveAs strFileName, xlNormal
    End If

Exit_ExportToExcel3:
    Set objExcel = Nothing
    Set objBook = Nothing
    Exit Function

Err_ExportToExcel3:
    Resume Exit_ExportToExcel3
End Function