sql 文件导入nactive都不成功_用SQL导入数据，可查询到 记录条数，但不能实现数据导入，请高手指点迷津，！！...

本帖最后由 7433518 于 2016-4-29 21:26 编辑

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

运行没有提示出错，可正确显示记录条数，但不能导入数据，请指点问题出在哪儿？？？，谢谢！！！

2016-4-29 20:17 上传

点击文件名下载附件

660.02 KB, 下载次数: 25