作者：乔山办公网日期：
返回目录：excel表格制作
你就换个思考，用ACCESS来读写EXCEL，ACCESS可以做连接表，连接表链接方法优化了处理效率，VBA根本效率太低
1）用代码：引用dao或ADO对象建立access数据库的连接以读取数据
2）在excel中直接导入：（推荐使用此法）
点数据选项卡左侧按钮
选择数据库
建立连接
输入密码，选择待导入数据表，确认导入地址
用access自动获取excel里的数据的方法就是通过代码的方式导入。如果是对手动导入比较清楚的话，这个实现起来不难。请参考下面的介绍来实现：
首先，新建一个工程，在工程中引用如下对象ADO对象（用于连接ACCESS数据库，可用其它方式）
添加一个窗体（from1），在窗体上添加如下控件：
两个文本框，用来显示EXCEL文件路径和ACCESS路径；
四个扭钮，两个用来游览，另两个是导入和退出；
两个通用对话框控件，用来打开e799bee5baa6e79fa5e98193e58685e5aeb9331ACCESS和EXCEL文件，一个进度条控件，用来显示导入进程。
该
实例的导入是将ACCESS数据库中表的字段名单独存放在另外一个表中,导入时按表中所存字段名的顺序进行导入,不是按EXCEL表的顺序导入,请大家注
意.这样在实际中是很实用的.因为好多时候EXCEL表中字段顺序和ACCESS中字段顺序有可能不是一致的.
代码如下：
Dim v
Option Explicit
Private Sub cmdLoad_Click()
Dim excel_app As Object
Dim excel_sheet As Object
If txtExcelFile.Text = "" Then
MsgBox "请选择EXCEL表"
Else
Dim new_value As String
Label2.Caption = "正在导入,请稍候..."
Screen.MousePointer = vbHourglass
DoEvents
'' Create the Excel application.
Set excel_app = CreateObject("Excel.Application")
'' Uncomment this line to make Excel visible.
excel_app.Visible = True
'' Open the Excel spreadsheet.
excel_app.Workbooks.open FileName:=txtExcelFile.Text
'' Check for later versions.
If Val(excel_app.Application.Version) >= 8 Then
Set excel_sheet = excel_app.ActiveSheet
Else
Set excel_sheet = excel_app
End If
Dim u ''求EXCEL表中记录的条数,以便控制进度条
u = 1
Do
If Trim$(excel_sheet.Cells(u, 1)) = "" Then Exit Do
u = u + 1
Loop
bar.Max = u - 1
strSQL = "select * from TestValues"
yourRecord.open strSQL, myConn, adOpenDynamic, adLockOptimistic ''打开记录集
Dim sql As String
sql = "select * from fields order by xue"
myRecord.open sql, myConn, adOpenDynamic, adLockBatchOptimistic ''打开字段记录集
myRecord.MoveFirst
'' Get data from the Excel spreadsheet and insert
'' it into the TestValues table.
Dim v ''导入记录,用了两层循环
v = 1
Do
If Trim$(excel_sheet.Cells(v, 1)) = "" Then Exit Do ''外层,如果EXCEL表中读取到空行,结束
yourRecord.AddNew
Dim i
For i = 1 To myRecord.RecordCount
'' Get the next value.
new_value = Trim$(excel_sheet.Cells(v, i))
'' See if it''s blank.
''If Len(new_value) = 0 Then Exit Do
'' Insert the value into the database.
Dim bb As String
bb = myRecord("name")
yourRecord(bb) = new_value
myRecord.MoveNext
Next i
bar.Value = v
v = v + 1
myRecord.MoveFirst
Loop
yourRecord.Update
'' Comment the rest of the lines to keep
'' Excel running so you can see it.
'' Close the workbook without saving.
excel_app.ActiveWorkbook.Close False
'' Close Excel.
excel_app.Quit
Set excel_sheet = Nothing
Set excel_app = Nothing
myRecord.Close
yourRecord.Close
Set myRecord = Nothing
Set yourRecord = Nothing
Label2.Caption = "导入完毕"
Screen.MousePointer = vbDefault
MsgBox "共导入" & Format$(v - 1) & "条记录"
End If
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click(Index As Integer)
''寻找ACCESS数据库
CommonDialog1.Filter = "ACCESS 文件(*.mdb)|*.mdb"
CommonDialog1.CancelError = True
CommonDialog1.ShowOpen
txtAccessFile.Text = CommonDialog1.FileName
End Sub
Private Sub Command3_Click()
''寻找excel数据库
CommonDialog2.Filter = "excel 文件(*.xls)|*.xls"
CommonDialog2.CancelError = True
CommonDialog2.ShowOpen
txtExcelFile.Text = CommonDialog2.FileName
End Sub
Private Sub Form_Load()
Call Module1.lianjie
txtAccessFile.Text = datapath
End Sub
模块（module1）中的代码如下：
Public myConn As New ADODB.Connection ''定义连接字符串
Public myRecord As New ADODB.Recordset ''定义记录集(字段)
Public yourRecord As New ADODB.Recordset ''定义记录集(数据)
Public cntoad As Boolean ''是否正常连接
Public ml ''姓名字段所在列
Public strSQL ''查询字符串
Public MyDatabase As Database ''定义数据库名
Public MyTable As TableDef, MyField As Field ''定义表名和字段名
Public xuehao ''读取字段序号
Public goshiRecord As New ADODB.Recordset ''定义记录集(公式)
Public hxfyn As Boolean
Public hxfbds '' 公式或条件
Public duan ''要统计的字段
Public islinshi As Boolean ''是否为临时公式
Public leiRecord As New ADODB.Recordset ''定义记录集(工资类别)
Public datapath As String ''数据库路径及名
Public table As String ''工资表名
Public lei As String '' 工资类别
Public Sub lianjie() ''打开数据库
On Error Resume Next
myConn.Close
Dim mySQL As String
''设定连接字符串
mySQL = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;"
mySQL = mySQL + "Data Source=" & datapath
myConn.ConnectionString = mySQL ''设定连接
myConn.open ''打开连接
myRecord.ActiveConnection = myConn ''设定RecordSeet的连接对象为Connection
myRecord.CursorLocation = adUseClient
goshiRecord.ActiveConnection = myConn ''设定RecordSeet的连接对象为Connection
goshiRecord.CursorLocation = adUseClient
yourRecord.ActiveConnection = myConn ''设定RecordSeet的连接对象为Connection
yourRecord.CursorLocation = adUseClient
End Sub
ACCESS你又不是程序自动创建的，既然是已知的，ACCESS完全可以创建EXCEL连接表啊，直接操作e68a847a686964616f365查询，VB执行超做查询不就简单多了，哪有这么麻烦。
如果是中途创建的，一 可以用ODBC连接查询啊。ACCESS有个ODBC库你看到没有，他有一个类库接口的，在查询EXCEL表操作ACCESS表的时候可以这样写：
SQL="Insert Into ACCESS表名 IN ODBC[ODBC;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Application.ThisWorkBook.Path + "/myData.mdb] as 查询1 Select * from EXCEL表 Inner Join 查询1 on EXCEL表.字段=查询1.字段 where ((查询1.字段) Is Not Null)"
这句SQL的意思是将跨服务器的ACCESS表插入到EXCEL表，并且当ACCESS表字段和EXCEL表字段连接查询有结果时不重复插入。不知道你看明白没有，DAO做操作查询的时候必须用Excute过程(引用ODA类库)：
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Set cnn=new ADODB.Connection
Set rs=new ADODB.Recordset
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Application.ThisWorkBook.Path + "Sheet1;Extend Propties="EXCEL 8.0;HDR=1""
rs.Open "Select * from [Sheet1]",cnn
SQL="上面的"
If Not rs.Eof Then
cnn.Excute SQL
End If
存储过程要这么写，VB操作查询必须要特定步骤