用VB创建和修改查询

todaynew

　　用TransferSpreadsheet导出Ｅｘｃｅｌ时，你常常会遇到一个麻烦，就是你需要一个查询的名称，没有这个名称你是无法导出你需要的数据的。你固然可以用向导事先建立你需要的查询，你也就有了这个查询名称。但是，当的程序已经开始运用了，此时你或你程序的使用者，或许需要改变你对导出数据的想法时，你的麻烦就来了。这时你就琢磨了，当初怎么不考虑扩展性问题呢？于是乎，你便会想到论坛上的这个帖子了。

　　起初写这个帖子时的想法是为了解决以上问题的，不过想了想，问题需要简化成《用ＶＢ创建和修改查询》，简化的结果是你没有发现导出Ｅｘｃｅｌ问题，倒是可以沿着这个思路找到更为广泛的用途。

　　这个帖子是为初学者撰写的，这样声明的含义有两层：其一是本人是初学者，因此代码可能不完善；其二是仅对初学者有帮助，因此代码很简单。

　　





Option Compare Database
Dim Qdef As QueryDef
Dim strsql As String
Dim strname As String

Private Sub 创建查询_Click()
strname = InputBox$("输入查询名称：", "查询名称", "临时查询")
On Error GoTo 创建_Err
     strsql = Me.子窗体.Form.RecordSource
     strsql = InputBox$("输入SQL语句：", "SQL语句", "select * from " & strsql & " where 准则;")
    Set Qdef = CurrentDb.CreateQueryDef(strname)  '创建查询
    Qdef.SQL = strsql                                             '创建查询
     Me.子窗体.Form.RecordSource = strname
     Me.子窗体.Form.Requery
     Qdef.Close
     Set Qdef = Nothing
创建_Exit:
     Exit Sub
创建_Err:
     MsgBox strname & " 已存在！"
     Resume 创建_Exit
End Sub

Private Sub 删除查询_Click()
strname = InputBox$("输入查询名称：", "查询名称", "临时查询")
On Error GoTo 删除_Err
     Me.子窗体.Form.RecordSource = "成绩查询"
     Me.子窗体.Form.Requery
     DoCmd.DeleteObject acQuery, strname
删除_Exit:
     Exit Sub
删除_Err:
     MsgBox strname & " 不存在！"
     Resume 删除_Exit
End Sub

Private Sub 修改查询_Click()
strname = InputBox$("输入查询名称：", "查询名称", "临时查询")
On Error GoTo 修改_Err
     Me.子窗体.Form.RecordSource = "成绩查询"
     strsql = Me.子窗体.Form.RecordSource
     strsql = InputBox$("输入SQL语句：", "SQL语句", "select * from " & strsql & " where 准则;")
    Set Qdef = CurrentDb.QueryDefs(strname)  '修改查询
    Qdef.SQL = strsql                                     '修改查询
     Me.子窗体.Form.RecordSource = strname
     Me.子窗体.Form.Requery
     Qdef.Close
     Set Qdef = Nothing
修改_Exit:
     Exit Sub
修改_Err:
     MsgBox strname & " 不存在！"
     Resume 修改_Exit
End Sub


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

ACMAIN_CHM

一上来就看到 todaynew  的新作，先来踹上一脚再说。



******************
*  一切皆有可能  *
******************
.
ACMAIN - Access论坛回贴准则（个人）.
.
同一贴子不回复第二次
.
QQ群 48866293 / 12035577 / 7440532 / 13666209
http://forum.csdn.net/BList/OtherDatabase .
http://www.accessbbs.cn/bbs/index.php .
http://www.accessoft.com/bbs/index.asp .
http://www.access-programmers.co.uk/forums .
http://www.office-cn.net .
.
http://www.office-cn.net/home/space.php?uid=141646 .

todaynew

一上来就看到 todaynew  的新作，先来踹上一脚再说。



******************
*  一切皆有可能 ...
ACMAIN_CHM 发表于 2009-3-7 18:26

chaojianan

1楼和2楼都是高手，佩服，
向您们看齐，学习。

wanglhc

学习，太强了

Santree

昨天找了这个东东大半天 ，

ZZBZZBZZZB

谢谢

zzxgenius529

真好啊

heqing3000

看见好东西必顶无疑！

jsnjhu

再次感谢todaynew老师指导