如何从EXCEL中把数据导入到ACCESS库中去？

Question

可以安装sql server 服务端
通过sql server 提供的工具导入导出
非常方便

Answer 1

Dim cnn As New ADODB.Connection, rs As New ADODB.Recordset
Dim cnn1 As New ADODB.Connection, rs1 As New ADODB.Recordset
Dim sAccessDBPath, sAccessTable, sSheetName As StringsAccessDBPath = App.Path & "\数据库.mdb"
sAccessTable = "Users_temp（暂存数据临时表）"
With CommonDialog1
.ShowOpen
sSheetName = InputBox(vbCrLf & "    请输入含有用户数据的工作表的名称" & vbCrLf & vbCrLf & "    （如果不是“Sheet1”）", "工作表的名称", "Sheet1")
Set cnn1 = New ADODB.Connectioncnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=" & .FileName & ";" & _
           "Extended Properties=""Excel 8.0;"""rs1.Open " Select * FROM [" & sSheetName & "$]", cnn1, adOpenForwardOnly, adLockReadOnly
之后加入表中即可

Answer 2

不行，发生错误，错误提示为：找不到可插入的ISAM。请各位继续解答，谢谢！

Answer 3

http://www.freevbcode.com有个代码用一条SQL语句解决，如找不到给我发消息。

Answer 4

循环取出Excel中的值再添加到Access中不就行了.

Answer 5

Dim dbs As Database
Set dbs = OpenDatabase(App.Path & "\db1.mdb")
On Error Resume Next
dbs.Execute "DROP TABLE 在校学生;"
dbs.Execute "SELECT *  INTO 在校学生 FROM [Excel 8.0;DATABASE=" & App.Path & "\MyExcel.xls].[WorkSheet1] "
dbs.Close
Set dbs = Nothing

Answer 6

有用ADO，直接在ACCESS一个已存在的表中追加记录的办法吗？

Answer 7

有很多方法都可将数据库中某个表的数据导出到电子表格中，例如通过创建Access.Application，可以利用Access本身的导出功能实现将表中的数据导出到电子表格中。但是这种方法会占用较多的系统资源，并且缺乏通用性。如果一个数据库没有导出的功能怎么办？下面的这段程序代码利用记录集实现导出的功能，这种做法的好处是显而易见的：你可以控制要导出的数据，而不用将整个表的内容都导出到电子表格中。为简单起见下面的程序代码仍将整个表的数据导出到电子表格中。如果你有兴趣的话，对下面的代码稍加改动就可做成更为通用的一个类或是一个控件。 首先在窗体上添加一个标签控件和一个命令按钮，然后在工程中添加对DAO引用。利用下面的程序代码就可将表中的数据导出到电子表格中。Option ExplicitPrivate Sub Command1_Click()
        Dim tempDB As Database
        Dim i As Integer           ' 循环计数器
        Dim j As Integer
        Dim rCount As Long         ' 记录的个数
        Dim xl As Object           ' OLE自动化对象
        Dim Sn As Recordset
        Screen.MousePointer = 11
        Label1.Caption = "打开数据库..."
        Label1.Refresh
        Set tempDB = Workspaces(0).OpenDatabase("Nwind.mdb")
        Label1.Caption = "创建Excel对象..."
        Label1.Refresh
        Set xl = CreateObject("Excel.Sheet.8")
        Label1.Caption = "创建快照型记录集..."
        Label1.Refresh
        Set Sn = tempDB.OpenRecordset("Customers", dbOpenSnapshot)         If Sn.RecordCount > 0 Then
            Label1.Caption = "将字段名添加到电子表格中"
            Label1.Refresh
            For i = 0 To Sn.Fields.Count - 1
                xl.Worksheets(1).cells(1, i + 1).Value = Sn(i).Name
            Next
            Sn.MoveLast
            Sn.MoveFirst
            rCount = Sn.RecordCount
            ' 在记录中循环
            i = 0
            Do While Not Sn.EOF
                Label1.Caption = "Record:" & Str(i + 1) & " of" & _
                Str(rCount)
                Label1.Refresh
                For j = 0 To Sn.Fields.Count - 1
                   ' 加每个字段的值加到工作表中
                   If Sn(j).Type < 11 Then
                      xl.Worksheets(1).cells(i + 2, j + 1).Value = Sn(j)
                   Else
                      ' 处理Memo和LongBinary 类型的字段
                     xl.Worksheets(1).cells(i + 2, j + 1).Value = "Memo or Binary Data"
                   End If
                Next j
                Sn.MoveNext
                i = i + 1
            Loop
            ' 保存工作表
            Label1.Caption = "保存文件..."
            Label1.Refresh
            xl.SaveAs "c:\Customers.XLS"
            '从内存中删除Excel对象
            Label1.Caption = "退出Excel"
            Label1.Refresh
            xl.Application.Quit
         Else
            ' 没有记录
         End If
         ' 清除
         Label1.Caption = "清除对象"
         Label1.Refresh
         Set xl = Nothing
         Set Sn = Nothing
         Set tempDB = Nothing
         Screen.MousePointer = 0  ' 恢复鼠标指针
         Label1.Caption = "Ready"
         Label1.Refresh
End SubPrivate Sub Form_Load()
    Label1.AutoSize = True
    Label1.Caption = "Ready"
    Label1.Refresh
End Sub

Answer 8

先在EXCEL里选中数据（不要表头），按Ctrl-C将其复制到剪贴板；
再在ACCESS里打开表，选中最后的空行后，按Ctrl-V将剪贴板内容
粘贴进来即可。

Answer 9

这个问题我还没有解决，请各位大侠继续帮助我解决此问题，万分感谢！
另我的错误提示为：“找不到可插入的ISAM ”，请问该如何解决？

Answer 10

private Const Provider = "Microsoft.Jet.OLEDB.4.0"
private Const ExtendedProperties = "Excel 8.0"    DBCn_xls.Provider = Provider
    DBCn_xls.Properties("Extended Properties") = ExtendedProperties
    DBCn_xls.Properties("Data Source") = sSaveAsFile
    DBCn_xls.Open
    
    Set DBRs_xls = DBCn_xls.Execute("Select * from `Employee$` ")    DBCn_acc.Provider = Provider
    DBCn_acc.Properties("Data Source") = App.Path & "\data.mdb"
    DBCn_acc.Open    DBRs_acc.Open "select * from test1", DBCn_acc
       
    While Not DBRs_xls.EOF
        j = j + 1
        pgbRead.Value = j
        DBRs_acc.AddNew
        For i = 0 To DBRs_xls.Fields.Count - 1
            Select Case vDBRs_xls.Fields(i).Type
                Case adWChar, adVarWChar, adChar, adBSTR, adChapter, adLongVarChar, adLongVarWChar, adWChar, adVarChar
                    DBRs_acc.Fields(i) = Left(NullValue(vDBRs_xls.Fields(i)), 124)
                Case adDouble, adBigInt, adCurrency, adDecimal, adInteger, adNumeric, adSingle, adSmallInt, adTinyInt, adUnsignedBigInt, adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt
                    DBRs_acc.Fields(i) = Left(CStr(Format(vDBRs_xls.Fields(i), "00000000000.00")), 124)
                Case adDate, adDBTime
                    DBRs_acc.Fields(i) = Left(CStr(Format(vDBRs_xls.Fields(i), "yyyy年MM月dd日")), 124)
                Case Else
                    DBRs_acc.Fields(i) = Left(NullValue(vDBRs_xls.Fields(i)), 124)
            End Select
            DoEvents
        Next
        DBRs_acc.Update
        vDBRs_xls.MoveNext
        DoEvents
    Wend
 
   DBRs_acc.Close
   DBRs_xls.Close

Answer 11

ncoxwwz(wwz) ，你好！1、首先是你的jet版本低了，他们介绍的方法，都需要jet 4.0以上。
2、下面是我的方法。
cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=" & .Filename & ";" & _
           "Extended Properties=""Excel 8.0;HDR=yes;"""
    rs1.Open " Select * FROM [" & "Sheet1" & "$]", cnn1, adOpenForwardOnly, adLockReadOnly        Do While Not (rs1.EOF)
            rs.AddNew
            'TempStr = "这条记录导入失败！" & vbLf
            Dim i As Integer
            For i = 0 To rs.Fields.Count - 3
                rs.Fields(i).Value = rs1.Fields(i).Value
                'TempStr = TempStr & rs1.Fields(i).Value & vbTab
            Next
            rs.Update
            rs1.MoveNext
        Loop
我的，

Answer 12

谢谢楼上的方法，但我引用的JET版本是3.51，请问那里有更高版本的JET下载。请教，谢谢！EXCEL为XP版本。操作系统是XP。

Answer 13

jet 是随office而来的，安装office 2k就可以了

Answer 14

http://download.microsoft.com/download/dasdk/Install/2.60.6526.3/WIN98Me/CN/MDAC_TYP.EXE
http://download.microsoft.com/download/Jet40/SP/4.0.6226/W9XNT4/EN-US/Jet40SP6_9xNT.exe

Answer 15

有一个非常简单的方法，你可用ado方法
dim db as database,rs as recordset
set db=dbengin.workspace(0).opendatabase("你的数据库文件",,"excel 8.0")
然后你可将里面的表当成access里面的表那样用比如
set rs=db.open("sheet1")
如果你想将结果另存的话使用SQL语句就可以了。需有源码么？