vba如何调用Access的查询,并显示查询结果?
想请教大家一个问题啊:我写了一个VBA程序,与Access连起来了,我想执行Access里面的写好的查询(query).并将结果显示出来,请问,可以这样做吗?Public...
想请教大家一个问题啊:
我写了一个VBA程序 ,与Access连起来了,我想执行Access里面的写好的查询(query).并将结果显示出来,请问,可以这样做吗 ?
Public Sub Test_Access()
'与数据库的连接操作
Dim Conn1
Set Conn1 = CreateObject("ADODB.Connection")
Conn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=D:\Profiles\r60162\Desktop\完整版Model\完整版Model\1.mdb"
Conn1.Open
Set rs = CreateObject("ADODB.Recordset")
rs.Open "Select * from Fotd1", Conn1, adOpenStatic
Do While(Notrs.EOF) '循环显示指定条数的记录
MsgBox rs("Pkg_Cd")
rs.movenext '指向下一条记录
If rs.EOF Then Exit Do'已经到底最后一条记录则跳出
Loop
End Sub
其中的Fotd1,是我在Access中写好的查询,
其具体代码如下:
SELECT Pkg_Cd, Prod_Line, FG_Device, Tester, STW, MIN, MAX, [200620], [200621a], [200621b], [640_Engr_Hold_WIP], [630_Tst_WIP], [670_T&R_WIP], [720_Tray_WIP], tst_hold
FROM FOTD
WHERE Tester like "J750*" and STW<>0
ORDER BY MIN DESC;
我现在就是想将Fotd1里面的Pkg_Cd字段的内容找出来,打印在Excel中。 展开
我写了一个VBA程序 ,与Access连起来了,我想执行Access里面的写好的查询(query).并将结果显示出来,请问,可以这样做吗 ?
Public Sub Test_Access()
'与数据库的连接操作
Dim Conn1
Set Conn1 = CreateObject("ADODB.Connection")
Conn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=D:\Profiles\r60162\Desktop\完整版Model\完整版Model\1.mdb"
Conn1.Open
Set rs = CreateObject("ADODB.Recordset")
rs.Open "Select * from Fotd1", Conn1, adOpenStatic
Do While(Notrs.EOF) '循环显示指定条数的记录
MsgBox rs("Pkg_Cd")
rs.movenext '指向下一条记录
If rs.EOF Then Exit Do'已经到底最后一条记录则跳出
Loop
End Sub
其中的Fotd1,是我在Access中写好的查询,
其具体代码如下:
SELECT Pkg_Cd, Prod_Line, FG_Device, Tester, STW, MIN, MAX, [200620], [200621a], [200621b], [640_Engr_Hold_WIP], [630_Tst_WIP], [670_T&R_WIP], [720_Tray_WIP], tst_hold
FROM FOTD
WHERE Tester like "J750*" and STW<>0
ORDER BY MIN DESC;
我现在就是想将Fotd1里面的Pkg_Cd字段的内容找出来,打印在Excel中。 展开
4个回答
展开全部
当然可以,用DAO,可以在VB添加DAO组件。
然后,定义参数
'Database Connection
Dim cn As Workspace
Dim db As Database
Dim Rs As Recordset
Dim YOURPWD$, strSQL$, sContent$
'设置数据库
Set cn = DBEngine.Workspaces(0)
Set db = cn.OpenDatabase(sDbPath, False, False, ";pwd=" & YOURPWD)
'打开数据库
strSQL = "Select * From YourTable"
Set Rs = db.OpenRecordset(strSQL, , dbReadOnly)
'取出一个不为NULL的字符串字段值
sContent = trim$(Rs!Item1)
--------------------------------------------------------------
'使用前提在VB中加入VB组件
Dim xlsApp As Object, xlsBook As Object, xlsSheet As Object
Dim Row&, Col&
On Error GoTo ExcelInport_Err
'创建应用Excel程序
Set xlsApp = CreateObject("Excel.Application")
'Excel WorkBook 的添加
Set xlsBook = xlsApp.Workbooks.Add
’取得活动的Excel Sheet
Set xlsSheet = xlsBook.ActiveSheet
'Excel Sheet的标题
xlsSheet.Name = "Your Sheet Name"
'Excel Sheet 内容的填充
With xlsSheet
Row = 1 '行
Col = 1 '列
.Cells(Row, Col).Value = "Your Fill Content"
End With
‘Excel
xlsApp.Visible = True
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
Exit Sub
ExcelInport_Err:
'关闭时没有消息框
xlsApp.DisplayAlerts = False
xlsApp.Quit
Set xlsApp = Nothing
然后,定义参数
'Database Connection
Dim cn As Workspace
Dim db As Database
Dim Rs As Recordset
Dim YOURPWD$, strSQL$, sContent$
'设置数据库
Set cn = DBEngine.Workspaces(0)
Set db = cn.OpenDatabase(sDbPath, False, False, ";pwd=" & YOURPWD)
'打开数据库
strSQL = "Select * From YourTable"
Set Rs = db.OpenRecordset(strSQL, , dbReadOnly)
'取出一个不为NULL的字符串字段值
sContent = trim$(Rs!Item1)
--------------------------------------------------------------
'使用前提在VB中加入VB组件
Dim xlsApp As Object, xlsBook As Object, xlsSheet As Object
Dim Row&, Col&
On Error GoTo ExcelInport_Err
'创建应用Excel程序
Set xlsApp = CreateObject("Excel.Application")
'Excel WorkBook 的添加
Set xlsBook = xlsApp.Workbooks.Add
’取得活动的Excel Sheet
Set xlsSheet = xlsBook.ActiveSheet
'Excel Sheet的标题
xlsSheet.Name = "Your Sheet Name"
'Excel Sheet 内容的填充
With xlsSheet
Row = 1 '行
Col = 1 '列
.Cells(Row, Col).Value = "Your Fill Content"
End With
‘Excel
xlsApp.Visible = True
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
Exit Sub
ExcelInport_Err:
'关闭时没有消息框
xlsApp.DisplayAlerts = False
xlsApp.Quit
Set xlsApp = Nothing
本回答被提问者和网友采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
vba调用Access的查询,并显示查询结果的方法如下:
用DAO,可以在VBA添加DAO组件。
然后,定义参数,写好相应的代码就可以了。
具体代码如下:
'Database Connection
Dim cn As Workspace
Dim db As Database
Dim Rs As Recordset
Dim YOURPWD$, strSQL$, sContent$
'设置数据库
Set cn = DBEngine.Workspaces(0)
Set db = cn.OpenDatabase(sDbPath, False, False, ";pwd=" & YOURPWD)
'打开数据库
strSQL = "Select * From YourTable"
Set Rs = db.OpenRecordset(strSQL, , dbReadOnly)
'取出一个不为NULL的字符串字段值
sContent = trim$(Rs!Item1)
--------------------------------------------------------------
'使用前提在VB中加入VB组件
Dim xlsApp As Object, xlsBook As Object, xlsSheet As Object
Dim Row&, Col&
On Error GoTo ExcelInport_Err
'创建应用Excel程序
Set xlsApp = CreateObject("Excel.Application")
'Excel WorkBook 的添加
Set xlsBook = xlsApp.Workbooks.Add
’取得活动的Excel Sheet
Set xlsSheet = xlsBook.ActiveSheet
'Excel Sheet的标题
xlsSheet.Name = "Your Sheet Name"
'Excel Sheet 内容的填充
With xlsSheet
Row = 1
'行
Col = 1
'列
.Cells(Row, Col).Value = "Your Fill Content"
End With
‘Excel
xlsApp.Visible = True
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
Exit Sub
ExcelInport_Err:
'关闭时没有消息框
xlsApp.DisplayAlerts = False
xlsApp.Quit
Set xlsApp = Nothing
用DAO,可以在VBA添加DAO组件。
然后,定义参数,写好相应的代码就可以了。
具体代码如下:
'Database Connection
Dim cn As Workspace
Dim db As Database
Dim Rs As Recordset
Dim YOURPWD$, strSQL$, sContent$
'设置数据库
Set cn = DBEngine.Workspaces(0)
Set db = cn.OpenDatabase(sDbPath, False, False, ";pwd=" & YOURPWD)
'打开数据库
strSQL = "Select * From YourTable"
Set Rs = db.OpenRecordset(strSQL, , dbReadOnly)
'取出一个不为NULL的字符串字段值
sContent = trim$(Rs!Item1)
--------------------------------------------------------------
'使用前提在VB中加入VB组件
Dim xlsApp As Object, xlsBook As Object, xlsSheet As Object
Dim Row&, Col&
On Error GoTo ExcelInport_Err
'创建应用Excel程序
Set xlsApp = CreateObject("Excel.Application")
'Excel WorkBook 的添加
Set xlsBook = xlsApp.Workbooks.Add
’取得活动的Excel Sheet
Set xlsSheet = xlsBook.ActiveSheet
'Excel Sheet的标题
xlsSheet.Name = "Your Sheet Name"
'Excel Sheet 内容的填充
With xlsSheet
Row = 1
'行
Col = 1
'列
.Cells(Row, Col).Value = "Your Fill Content"
End With
‘Excel
xlsApp.Visible = True
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
Exit Sub
ExcelInport_Err:
'关闭时没有消息框
xlsApp.DisplayAlerts = False
xlsApp.Quit
Set xlsApp = Nothing
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询