指定记录导入Excel

       StrSor = "D:\摸板.xls"    '你特定格式的EXCEL表
        StrDtn = "D:\目标.xls"    '导出后保存到哪个文件
       FileCopy StrSor, StrDtn                      

    Dim xlApp As Excel.Application                           
    Dim xlBook As Excel.Workbook                              
    Dim xlSheet As Excel.Worksheet                              
    Dim dbs As Database, strSQL As String, x As Integer
    Dim qdf As QueryDef
    Dim TableA As Variant, wks As Workspace

    Set wks = Workspaces(0)
    Set dbs = CurrentDb()
    Set xlApp = CreateObject("Excel.Application")       
    Set xlApp = New Excel.Application
        xlApp.Visible = True                             
    Set xlBook = xlApp.Workbooks.Open("D:\YP.xls")

 
    Set xlSheet = xlBook.Worksheets(1)                   
      
         Set TableA = dbs.OpenRecordset("NBPORT_OK", dbOpenSnapshot)    '"NBPORT_OK"可以设置为你子窗体的数据源

    TableA.MoveFirst
x = 9   '从EXCEL第几行开始写

       Do Until TableA.EOF = True
           
                 xlSheet.Cells(x, 29) = TableA![CMA45HC]   '第X行的第29列
                xlSheet.Cells(x, 30) = TableA![CMA20RF]
                xlSheet.Cells(x, 31) = TableA![CMA40RH]
  
                x = x + 1

                TableA.MoveNext
            Loop

                dbs.Close
                xlBook.Save

MsgBox "ok"