vb6.0中如何把<em>EXCEL</em>表格中的数据导入到access库...

rst.Open Sql, cn.ConnectionString

 我的数据库语言不是很好，但看了你的代码，也觉得很乱，你的代码至少有好几种方法可以修改，上面是最简单的一种，实际上你的数据库在acapp.OpenCurrentDatabase的时候已经打开了，接下来根本就不需要再次使用cn进行连接。

所以第二种改法是：

acApp.OpenCurrentDatabase (dbPath)
'Dim cn As ADODB.Connection   '不需要再次连接
'Set cn = acApp.CurrentProject.Connection   '不需要再次连接
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
Dim Sql As String
Sql = "Select * From 0012X32"
rst.Open Sql, acApp.ADOConnectString   '我只需要在这里调用连接的数据就可以了，而这个连接数据存储在acApp.ADOConnectString里面。
rst.MoveFirst

 

下面是RecordSet的OPEN的用法：

Open 方法 (ADO Recordset)
打开游标。
语法
recordset.Open Source, ActiveConnection, CursorType, LockType, Options
参数
Source 可选。Variant，计算有效的 Command 对象、SQL 语句、表名、存储过程调用、URL 或包含持久存储 Recordset 的文件名或 Stream 对象。
ActiveConnection 可选。Variant，计算有效的 Connection 对象变量名，或包含 ConnectionString 参数的 String。
CursorType 可选。CursorTypeEnum 值，确定在打开 Recordset 时提供者应使用的游标类型。默认值为 adOpenForwardOnly。
LockType 可选。LockTypeEnum 值，确定在打开 Recordset 时提供者应使用的锁定（并发）类型。默认值为 adLockReadOnly。
Options 可选。Long 值，指示提供者计算 Source 参数的方式（如果该参数表示除 Command 对象之外的某些内容），或者指示 Recordset 应该从以前保存e799bee5baa6e79fa5e98193e59b9ee7ad94362过的文件中恢复。可以是一个或多个 CommandTypeEnum 或 ExecuteOptionEnum 值，这些值可以用位 AND 操作符组合。
注意   如果从包含持久 Recordset 的 Stream 中打开 Recordset，那么使用 adAsyncFetchNonBlocking 的 ExecuteOptionEnum 值将不起作用；提取操作将同步进行并发生阻塞。adExecuteNoRecords 或 adExecuteStream 的 ExecuteOpenEnum 值不应与 Open 一起使用。

因为ADO语言，直接提供了连接数据库的方法，所以我们可以直接这样来连接数据库：（算作本题的第三种改法吧）

Dim cn As New ADODB.Connection    '直接创建对数据库连接的实例对象cn
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath  '连接数据库
Dim rst As New ADODB.Recordset
Dim Sql As String
Sql = "Select * From 0012X32"
rst.Open Sql, cn
rst.MoveFirst
rst.Move (1)
MsgBox rst.Fields(1).Value

不知道VB和VBA有什么差别e79fa5e98193e78988e69d83338啊
以下是我学习VBA的代码，看看吧
Public Sub 将数据库记录数据全部导入到excel工作表ADO之一()
Dim myData As String, myTable As String, SQL As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
'清除工作表的全部数据
ActiveSheet.Cells.Clear
myData = ThisWorkbook.Path & "\学生成绩管理.mdb" '指定数据库
myTable = "期末成绩" '指定数据表
'建立与数据库的连接
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open myData
End With
'查询数据表
SQL = "select * from " & myTable & " order by 性别"
Set rs = New ADODB.Recordset
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
'显示查询结果
MsgBox "数据库中的记录数为：" & rs.RecordCount
'复制记录数据
If rs.RecordCount > 0 Then
'复制字段名
For i = 1 To rs.Fields.Count
Cells(1, i) = rs.Fields(i - 1).Name
Next i
'设置字段名字体为加粗并居中对齐
With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
'复制全部数据
Range("A2").CopyFromRecordset rs
'设置工作表格式
ActiveSheet.Cells.Font.Size = 10
ActiveSheet.Columns.AutoFit
End If
'关闭记录集及数据库连接，并释放变量
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
'·recordset对象的copyfromrecordset方法:
'用于将一个ADO或DAO的recordset对象的内容复制到工作表中，复制的起始位置在指定区域的左上角。
' 语法：expression.copyfromrecordset(data,maxrows,maxcolumns)
'expression表示一个工作表的range对象；
'data为必需参数，指定复制到指定区域的recordset对象；
'maxrows(可选):指定复制到工作表的记录个数上限，省略为复制所有记录；
'maxcolumns(可选)：指定复制到工作表的字段个数上限，省略将复制对象的所有字段
'copyfromrecordset方法只是复制记录集的记录数据，并不复制字段名，下列语句用fields集合的count属性获取字段总数，在循环中利用field对象的name属性获取字段名。
'For i = 1 To rs.Fields.Count
' Cells(1, i) = rs.Fields(i - 1).Name
'Next i
'复制的记录是从当前行开始的内容，复制完成之后，recordset对象的EOF属性值为True,因此在复制recordset对象内容后，如要重新浏览记录集的话，需使用rs.movefirst将记录指针移到第一条记录。
'·SQL语句:
'sqlect 字段列表 from 子句（表名）where 条件 group by 性别(分组) having avg(工资总额)>5000 (与group by 一起用) order by 姓名 asc(升序)/desc(降序)
End Sub

' 引用：microsoft activeX data objects 2.x library
Public Sub 将数据库记录数据全部导入到excel工作表ADO之二()
Dim myData As String, myTable As String, SQL As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
ActiveSheet.Cells.Clear '清除工作表的全部数据
myData = ThisWorkbook.Path & "\学生成绩管理.mdb" '指定数据库
myTable = "期末成绩" '指定数据表
'建立与数据库的连接
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open myData
End With
'查询数据表
SQL = "select * from " & myTable & " order by 数学"
Set rs = cnn.Execute(SQL)
'复制记录数据
If rs.EOF And rs.BOF Then
MsgBox "数据表中没有记录！", vbCritical
Else
'复制字段名
For i = 1 To rs.Fields.Count
Cells(1, i) = rs.Fields(i - 1).Name
Next i
'设置字段名字体为加粗并居中对齐
With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
'复制全部数据
Range("A2").CopyFromRecordset rs
'设置工作表格式
ActiveSheet.Cells.Font.Size = 10
ActiveSheet.Columns.AutoFit
End If
'关闭记录集及数据库连接，并释放变量
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

' 引用：microsoft activex data objects 2.x library
Public Sub 将数据库记录数据全部导入到Excel工作表ADO之三()
Dim myData As String, myTable As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
ActiveSheet.Cells.Clear '清除工作表的全部数据
myData = ThisWorkbook.Path & "\学生成绩管理.mdb" '指定数据库
myTable = "期末成绩" '指定数据表
'建立与数据库的连接
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open myData
End With
'查询数据表
Set rs = New ADODB.Recordset
rs.Open myTable, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
'显示查询结果
MsgBox "数据库中的记录数为：" & rs.RecordCount
' 复制记录数据
If rs.RecordCount > 0 Then
'复制字段名
For i = 1 To rs.Fields.Count
Cells(1, i) = rs.Fields(i - 1).Name
Next i
With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
'复制全部数据
Range("A2").CopyFromRecordset rs
'设置工作表格式
ActiveSheet.Cells.Font.Size = 10
ActiveSheet.Columns.AutoFit
End If
'关闭记录集及数据库连接，并释放变量
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing

'·注 之一1与之三的 区别：
'实例3-1中语句rs.open sql,cnn,adopenkeyset,adlockoptimistic和实例3-3中语句rs.open mytable,cnn,adopenkeyset,adlockoptimistic,adcmdtabledirect的区别：前者使用了sql语句来实现对数据表的查询，因此可以实现各种条件下的查询；而后者则使用数据表名来实现对数据表的查询，得到的数据是整个数据表，且无法对记录排序，除此之外两者的代码完全相同。
End Sub

' 引用：microsoft dao 3.6 object library
Public Sub 将数据库记录数据全部导入到Excel工作表DAO之一()
Dim myData As String, myTable As String, SQL As String
Dim myDb As DAO.Database
Dim myRs As DAO.Recordset
Dim i As Integer
ActiveSheet.Cells.Clear '清除工作表的全部数据
myData = ThisWorkbook.Path & "\学生成绩管理.mdb" '指定数据库
myTable = "期末成绩" '指定数据表
'建立与数据库的连接
Set myDb = OpenDatabase(myData)
'查询数据表
SQL = "select * from " & myTable & " order by 数学"
Set myRs = myDb.OpenRecordset(SQL)
'显示查询结果
MsgBox "数据库中的记录数为：" & myRs.RecordCount
'复制记录数据
If myRs.RecordCount > 0 Then
'复制字段名
For i = 1 To myRs.Fields.Count
Cells(1, i) = myRs.Fields(i - 1).Name
Next i
'设置字段名字体为加粗并居中对齐
With Range(Cells(1, 1), Cells(1, myRs.Fields.Count))
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
'复制全部数据
Range("A2").CopyFromRecordset myRs
'设置工作表格式
ActiveSheet.Cells.Font.Size = 10
ActiveSheet.Columns.AutoFit
End If
'关闭记录集及数据库连接，并释放变量
myRs.Close
myDb.Close
Set myRs = Nothing
Set myDb = Nothing

' ·DAO创建查询记录集要使用DAO.database对象的openrecordset方法?
'语法：set recordset=database.openrecordset(source,type,options,lockedits)
'databaseo为新建立的dao.database对象变量；
'source是记录集的数据源，可以是该数据库对象对应数据库的表名，也可以是SQL查询语句；
'type:指定新建的recordset对象的类型；
'options:指定新建的recordset对象的一些特性；
'lockedits: 控制对记录的锁定
'例: Set myRs = myDb.OpenRecordset(SQL)
End Sub

Public Sub 将数据库记录数据全部导入到Excel工作表DAO之二()
Dim myData As String, myTable As String
Dim myDb As DAO.Database
Dim myRs As DAO.Recordset
Dim i As Integer
ActiveSheet.Cells.Clear '清除工作表的全部数据
myData = ThisWorkbook.Path & "\职工管理.mdb" '指定数据库
myTable = "职工基本信息" '指定数据表
'建立与数据库的连接
Set myDb = OpenDatabase(myData)
'查询数据表
Set myRs = myDb.OpenRecordset(myTable)
'显示查询结果
MsgBox "数据库中的记录数为：" & myRs.RecordCount
'复制记录数据
If myRs.RecordCount > 0 Then
'复制字段名
For i = 1 To myRs.Fields.Count
Cells(1, i) = myRs.Fields(i - 1).Name
Next i
'设置字段名字体为加粗并居中对齐
With Range(Cells(1, 1), Cells(1, myRs.Fields.Count))
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
'复制全部数据
Range("A2").CopyFromRecordset myRs
'设置工作表格式
ActiveSheet.Cells.Font.Size = 10
ActiveSheet.Columns.AutoFit
End If
'关闭记录集及数据库连接，并释放变更
myRs.Close
myDb.Close
Set myRs = Nothing
Set myDb = Nothing
'·区别:
'之一使用SQL语句，而之二使用数据表来实现查询，其他相同。
End Sub
使用ADO运行来Insert 语句，一条条插入到Access或许可行吧。不过源貌似将数据从mdbA.tableA读入处理后生成SheetB，然后再mdbB中读百入SheetB比较省事吧，那要看你度的应用是怎样的了。貌似，Excel增强集工具问有个“连结外部数据”的功能，要不答楼主找找看吧

Private Sub cmdInData_Click()

On Error GoTo Err_cmdInData_Click

Dim strFileName As String '定义文件名变量
Dim strSql As String '定义查询语句
Dim lngN As Long
Dim lngRows As Long
Dim strMsg As String '定义错误语句
Dim blnReplace As Boolean '定义替换标志
Dim blnErrMark As Boolean '定义错误标志
Dim rst As Object 'DAO.Recordset
Dim objApp As Object 'Excel.Application
Dim objBook As Object 'Excel.Workbook

'使用文件对话框来获取文件名
With FileDialog(3) 'msoFileDialogFilePicker '(F1)--返回一个代表单个文件对话框实列FileDialog对象
'FileDialog(3).InitialFileName = CurrentProject.Path 下同
.InitialFileName = CurrentProject.Path
'返回一个值，表示文件对话框中初始显示的路径或文件名 可以使用通配符 .InitialFileName="c:\c*s?.txt" *表任意多个 ？表一个
'CurrentProject 返回“应用于”列表中的一个对象表达式
.Filters.Clear
.Filters.Add "Microsoft Excel", "*.xls"
'如果允许用户从文件对话框中选择多个文件，则返回 True Boolean类型 可读写
.AllowMultiSelect = False
'返回 FileDialogSelectedItems 集合。该集合包含用户在文件对话框中所选文件的列表，该对话框由 FileDialog 对象的 Show 方法打开。
If .Show Then strFileName = .SelectedItems(1)
End With

'如果对话框取消，则变了未被赋值，这时候退出程序
If strFileName = "" Then Exit Sub
'将光标设为沙漏，表示正在执行程序
DoCmd.Hourglass True
'将系统状态栏显示出来
SetOption "Show Status Bar", True
'在状态栏显示程序运行状态
SysCmd acSysCmdSetStatus, "正在读取Excel文件...."

'打开Excel文件

Set objApp = CreateObject("et.application")
Set objBook = objApp.workbooks.Open(strFileName, , True)
'这里没指定工作表名称，所有数据必须放在第一个工作表
objBook.worksheets(1).Select
With objApp
'根据列标题对于应得数据判断Excel中的数据是否能和表中的字段对应
'If MsgBox("请确认Excel数据表的行标题是否与数据库中的列标题一致，若一致，则进行导入，否则请退出导入！", _
'vbYesNo, "系统提示") = vbYes Then

strMsg = "先导入存入临时表，当e69da5e887aae79fa5e98193361导入的记录和表中已有记录重复时，是否进行替换？" & vbCrLf & vbCrLf & _
"选“是”将替换表中的已有记录。" & vbCrLf & _
"选“否”则忽略该记录不进入导入。"
Beep
blnReplace = (MsgBox(strMsg, vbQuestion + vbYesNo, "确定") = vbYes)
'记录数据是从第2行开始，所以先将计数器初始化为2
lngN = 2
'打开记录集，用来录入记录
Set rst = CurrentDb.OpenRecordset("tb_bill_tem", , 8) 'dbAppendOnly=8
'获取Excel中的记录行数
.range("A1").Select
.ActiveCell.SpecialCells(11).Select 'xlCellTypeLastCell=11
lngRows = .ActiveCell.Row
'在状态栏中创建进度条
SysCmd acSysCmdInitMeter, "正在导入数据....", lngRows
Do Until .range("A" & lngN) = "" '知道Excel表格读取的列数为空位置停止读取导入
'更新进度条
SysCmd acSysCmdUpdateMeter, lngN
rst.AddNew
'如果Excel单元格没有数据或读取的是空字符串,此时我需要安装需求填补到数据库中去
rst!部门 = IIf(.range("A" & lngN) = "", Null, .range("A" & lngN))
rst!日期 = IIf(.range("B" & lngN) = "", Null, .range("B" & lngN))
rst!投产单号 = IIf(.range("C" & lngN) = "", Null, .range("C" & lngN))
rst!订单数量 = IIf(.range("D" & lngN) = "", 0, .range("D" & lngN))
rst!模块型号 = IIf(.range("E" & lngN) = "", Null, .range("E" & lngN))
rst.Update
NextRow:
lngN = lngN + 1
Loop
rst.Close
End With

Me.frm_bill_tem_cld.Requery

strMsg = "数据导入完成！"

If blnErrMark Then strMsg = strMsg & "某些数据未能导入，点“确定”查看具体情况！"

SysCmd acSysCmdSetStatus, "导入完成！"
MsgBox strMsg, vbInformation, "提示"

'如果导入过程中产生了错误，则显示Excel以便查看那些未导入的记录出错的原因
If blnErrMark Then
objApp.range("F1").Select
'设置Saved属性为True，关闭时不保存写入的错误信息
objBook.saved = True
objApp.Visible = True
End If
'DoCmd.Hourglass False

Exit_cmdInData_Click:
If Not blnErrMark Then
If Not objApp Is Nothing Then objApp.Quit
End If

'销毁进度条
SysCmd acSysCmdRemoveMeter
'恢复光标
DoCmd.Hourglass False
Set rst = Nothing
Set objApp = Nothing
Set objBook = Nothing
Exit Sub

Err_cmdInData_Click:
Select Case Err
Case Is = 3022 '记录已存在的错误
'如果选择了替换，则先删除表中已有记录,重新保存
If blnReplace Then
CurrentDb.Execute "DELETE FROM tb_bill_tem WHERE 投产单号='" & objApp.range("C" & lngN) & "'"
Resume
Else
'否则将错误信息写入到Excel数据右边第一个空列
blnErrMark = True
objApp.range("F" & lngN) = "#3022 该记录已经在，未被导入。"
'然后恢复到NextRow标签处
Resume NextRow
End If
Case Else
'如果是其它错误，当lngN>=2时属于导入过程中的错误，这时将错误写入到Excel数据右边第1个空列
If lngN >= 2 Then
blnErrMark = True
objApp.range("F" & lngN) = "#" & Err & " " & Err.Description
'然后恢复到NextRow标签处
Resume NextRow
Else
'如果不是导入过程中的错误，则显示错误消息框，然后恢复到退出标签处
MsgBox Err.Description, vbCritical, "错误#" & Err
Resume Exit_cmdInData_Click
End If
End Select

End Sub