导入不入数据

Private Sub Command5_Click()
    On Error GoTo err
    Dim strPathName As String           '输出文件路径名
    Dim objApp As Object              'Excel程序
    Dim objBook As Object               'Excel工作簿
    Dim rst As Object                   '子窗体记录集
    Dim curSum As Currency              '折后金额总计
    Dim intN As Integer                 '循环计数器


    '通过对话框取得Excel文件名
    With FileDialog(3)    'msoFileDialogOpen
        .InitialFileName = CurrentProject.Path
        .Filters.Clear
        .Filters.Add "Microsoft Excel", "*.xlsx"
        If .Show Then strPathName = .SelectedItems(1)
    End With
    '对话框取消则退出过程
    If strPathName = "" Then Exit Sub


    '设置鼠标指针为沙漏形状
    '    DoCmd.Hourglass True
    '创建Excel对象
    Set objApp = CreateObject("Excel.Application")
    '打开模板文件
    Set objBook = objApp.Workbooks.Open(strPathName)
    '选中激活“销售订单”工作表
    'objBook.Sheets("sheet1").Select    '没有"sheet1"这个表名
    'objApp.Visible = True
    ' With objApp.ActiveSheet    '如果用ActiveSheet属性,就要事先设置属性objApp.Visible = True
    With objBook.Sheets("表1")
        intN = 2
        Set rst = Me.表1子窗体.Form.Recordset


        Do Until .Range("A" & intN) = ""
            Debug.Print intN, .Range("A" & intN)
            rst.AddNew
            rst.Fields(0) = .Range("A" & intN)
            rst.Fields(1) = .Range("b" & intN)
            rst.Update
            intN = intN + 1
            Me.Text7 = intN
        Loop
    End With


    MsgBox "导入成功！", vbInformation, "提示"
    objBook.Close
    Set objBook = Nothing
    Set objApp = Nothing
    Set rst = Nothing
    Exit Sub
err:
    MsgBox err.Description
    objBook.Close
    Set objBook = Nothing
    Set objApp = Nothing
    Set rst = Nothing
End Sub