VBA如何一次连接导入多个Access数据库查询结果

demonzhang 2004-09-13 09:56:47
小弟对VBA不太了解，现在用Excel的VBA作个小功能，请高手指教：
我要把一个access数据库（名字叫做NewTestModel）里边的几个表格中的数据进行相应的SQL查询后，将查询结果导入到Excel中。
下面的代码是我录入宏生成的代码，问题是如果按照下面的代码执行的话，要连接好几次Access数据库，能不能只连接一次就完成多次查询呢？

DBPath.Value="c:\NewTestModel.mdb"
Sheets(1).Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=""DBPath.Value"";Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet O","LEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLED" ,"B:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Databas" ,"e=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" ), Destination:=ActiveSheet.Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array( _
"SELECT Product_Line,FG_APO_Product,Start_Quantity, Available_Start_Week from TestIn_APO GROUP BY Product_Line,FG_APO_Product,Start_Quantity ,Available_Start_Week ORDER BY Available_Start_Week")
.Name = "NewTestModel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = DBPath.Value
.Refresh BackgroundQuery:=False

End With



Sheets(2).Select

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=""DBPath.Value"";Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet O" _
, _
"LEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLED" _
, _
"B:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Databas" _
, _
"e=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=ActiveSheet.Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("SELECT Product_Line, Package_Code,Tester,Handler,LB,Kit FROM ProductLine")
.Name = "NewTestModel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = DBPath.Value
.Refresh BackgroundQuery:=False
End With





Sheets(3).Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=""DBPath.Value"";Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet O" _
, _
"LEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLED" _
, _
"B:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Databas" _
, _
"e=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=ActiveSheet.Range("I1"))
.CommandType = xlCmdTable
.CommandText = Array("select Kit as KitModel, KitQty from KitQty order by Kit")
.Name = "NewTestModel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = DBPath.Value
.Refresh BackgroundQuery:=False
End With


ActiveSheet.Range("G1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=""DBPath.Value"";Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet O" _
, _
"LEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLED" _
, _
"B:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Databas" _
, _
"e=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=ActiveSheet.Range("G1"))
.CommandType = xlCmdTable
.CommandText = Array("select LoadBoard, LBQty from LBQty order by LoadBoard")
.Name = "NewTestModel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = DBPath.Value
.Refresh BackgroundQuery:=False
End With
..... '以下就不再列举了，大致都相同。望高手们能指教一下。多谢！！

...全文
241 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
demonzhang 2004-09-14
  • 打赏
  • 举报
 回复
不行啊，每次都是在sheets（1）中的rangee（“A1”）中插入。可能是由于刚开始的时候的定义，如：
Sheets(1).Select
With ActiveSheet.QueryTables.Add(Connection:=Array( 。。。。。。
' 这使得只对sheets（1）操作
xinliangyu 2004-09-13
  • 打赏
  • 举报
 回复
''去掉重复的连接连接部份，大致如下：
DBPath.Value="c:\NewTestModel.mdb"
Sheets(1).Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=""DBPath.Value"";Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet O","LEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLED" ,"B:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Databas" ,"e=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" ), Destination:=ActiveSheet.Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array( _
"SELECT Product_Line,FG_APO_Product,Start_Quantity, Available_Start_Week from TestIn_APO GROUP BY Product_Line,FG_APO_Product,Start_Quantity ,Available_Start_Week ORDER BY Available_Start_Week")
.Name = "NewTestModel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = DBPath.Value
.Refresh BackgroundQuery:=False

Sheets(2).Select
.CommandText = Array("SELECT Product_Line, Package_Code,Tester,Handler,LB,Kit FROM ProductLine")
.Name = "NewTestModel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = DBPath.Value
.Refresh BackgroundQuery:=False

Sheets(3).Select
.CommandText = Array("select Kit as KitModel, KitQty from KitQty order by Kit")
.Name = "NewTestModel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = DBPath.Value
.Refresh BackgroundQuery:=False

ActiveSheet.Range("G1").Select
.CommandType = xlCmdTable
.CommandText = Array("select LoadBoard, LBQty from LBQty order by LoadBoard")
.Name = "NewTestModel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = DBPath.Value
.Refresh BackgroundQuery:=False
End With
Excel连接Access数据库.rar
Excel连接Access数据库的VBA案例代码
Access数据库开发经典案例解析(随书光盘)
随书光盘 内含8个案例 经调试可用
txt导入access数据库例程.rar
txt导入access数据库例程.rar
Access数据库.accdb驱动
Access数据库.accdb驱动
将Access数据库导入Excel文件中
将Access数据库导入Excel文件中
VBA

2,506

社区成员

10,831

社区内容

发帖
与我相关
我的任务
社区描述
VBA（Visual Basic for Applications）是Visual Basic的一种宏语言，是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区管理员
  • VBA
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章