用SQL导入数据，可查询到 记录条数，但不能实现数据导入，请高手指点迷津，！！

7433518

Public Sub 导入()
    ''        On Error Resume Next
    dkpath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    Sheets("分析").Select
    wbyb = ActiveWindow.Caption
    Dim sha As Shape
    For Each sha In Sheets("分析").Shapes
        sha.Select
        Selection.Delete
    Next
    Application.DisplayAlerts = False
    Cells.Clear
    Cells.UnMerge
    Cells.NumberFormatLocal = "@"
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = True
    Application.StatusBar = "请选择源数据  ！！！ ，并确认导入。"

    ts = MsgBox("请选择源数据    ！！！ ，并确认导入。" & vbCrLf & vbCrLf, 4, "数据导入：")
    If ts = 6 Then
        Sheets("分析").Activate
        op = Application.GetOpenFilename()
        If op <> False And InStr(op, ".xl") Then
            Workbooks.Open Filename:=op
            wb = ActiveWindow.Caption
            Dim cnn As New ADODB.Connection
            Dim rs As New ADODB.Recordset
            Dim myBook As String, n As Integer, SQL As String
            Dim mySheet As String
            myBook = op
            mySheet = ActiveSheet.Name
            MsgBox myBook & vbCrLf & mySheet
            With cnn
                .Provider = "microsoft.jet.oledb.4.0"
                .ConnectionString = "Extended Properties=Excel 8.0;" _
                                  & "Data Source=" & myBook
                .Open
            End With
            SQL = "select * from [" & mySheet & "$] "
            rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
            n = rs.RecordCount
            If n > 0 Then
                MsgBox "查询到 " & n & " 条符合条件的记录。", vbInformation
                Cells.Clear
                For i = 1 To rs.Fields.Count
                    Cells(1, i) = rs.Fields(i - 1).Name
                Next i
                Range("A2").CopyFromRecordset rs
            Else
                MsgBox "没有查询到符合条件的记录。", vbInformation
            End If
            rs.Close
            cnn.Close
            Set rs = Nothing
            Set cnn = Nothing
            Set ws = Nothing
            ActiveWindow.Close
        End If
    End If
End Sub
运行没有提示出错，可正确显示记录条数，但不能导入数据，请指点问题出在哪儿？？？，谢谢！！！

7433518

求助，请伸出友谊之手，谢谢

7433518

已解决了，microsoft.jet.oledb.4.0只能打开2003以下的版本，换成Microsoft.ACE.OLEDB.12.0即可，因我的文件是2007格式的，所以不能导入，更换上句后，2003-2010均可导入。

7433518

已亲测成功

wangcq007

楼主，你说的方法并不能实现导入源表导入啊，仅仅导入了标题行。可以上传正确模板么

gemzw

真好有个导入问题下载试一下，谢谢1