| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1767 人关注过本帖
标题:excel連接access中的ado語句!
取消只看楼主 加入收藏
xunmi_love
Rank: 2
等 级:论坛游民
帖 子:204
专家分:18
注 册:2006-10-14
结帖率:57.14%
收藏
 问题点数:0 回复次数:0 
excel連接access中的ado語句!
Private Sub CommandButton1_Click()

[font=Times New Roman]
Dim [color=red]DB1 As Database    ((使用都自定義形態尚未定義!))
[/color][/font]
[font=Times New Roman]
Dim QRY1, myQRY As QueryDef
[/font]
[font=Times New Roman]
Dim QuerySting As String
[/font]
[font=Times New Roman]
Dim RS1 As Recordset
[/font]
[font=Times New Roman]
Dim isExist As Boolean
[/font]
   
[font=Times New Roman]'
On Error GoTo ErrorHandler
[/font]
   
[font=Times New Roman]
myPrjName = InputBox("
[/font]請輸入工程名稱:[font=Times New Roman]", "[/font]條件[font=Times New Roman]", "[/font]桂芳園五期[font=新細明體]")[/font]

[font=Times New Roman]
myPlanName = InputBox("
[/font]請輸入計畫單號:[font=Times New Roman]", "[/font]條件[font=新細明體]", "101102")[/font]



[font=Times New Roman]
If myPrjName = "" Then
[/font]
[font=Times New Roman]
If myPlanName = "" Then
[/font]
[font=Times New Roman]
MsgBox "
[/font]未選擇任何條件![font=Times New Roman]", vbOKOnly, "[/font]查詢退出[font=新細明體]"[/font]

[font=新細明體]
Exit Sub
[/font]

[font=新細明體]
Else
[/font]

[font=Times New Roman]
QueryString = "SELECT * FROM XC_Plan WHERE
[/font]計畫單號[font=新細明體] =" _[/font]

[font=Times New Roman]
& Chr(34) & myPlanName & Chr(34)
'chr(34)
[/font]即為[font=Times New Roman] " [/font]

[font=Times New Roman]
End If
[/font]
[font=Times New Roman]
Else
[/font]
[font=Times New Roman]
If myPlanName = "" Then
[/font]
[font=Times New Roman]
QueryString = "SELECT * FROM XC_Plan WHERE
[/font]工程名稱[font=新細明體]=" _[/font]

[font=新細明體]
& Chr(34) & myPrjName & Chr(34)
[/font]

[font=新細明體]
Else
[/font]

[font=Times New Roman]
QueryString = "SELECT * FROM XC_Plan WHERE
[/font]工程名稱[font=新細明體]=" _[/font]

[font=新細明體]
& Chr(34) & myPrjName & Chr(34) & " AND" _
[/font]

[font=Times New Roman]
& "
[/font]計畫單號[font=新細明體] = " & Chr(34) & myPlanName & Chr(34)[/font]

[font=Times New Roman]
End If
[/font]
[font=Times New Roman]
End If
[/font]
        
   
   
[font=Times New Roman]
Set DB1 = OpenDatabase(ThisWorkbook.Path & "\UserDB" & "\PLAN.MDB")
[/font]
   
[font=Times New Roman]
'
[/font]下面檢查[font=Times New Roman]  [/font]查詢[font=Times New Roman]temp [/font]是否存在

[font=Times New Roman]
For Each myQRY In DB1.QueryDefs
[/font]
[font=Times New Roman]
If myQRY.Name = "
[/font]查詢[font=新細明體]temp" Then[/font]

[font=新細明體]
isExist = True
[/font]

[font=新細明體]
End If
[/font]

[font=新細明體]
Next
[/font]

[font=Times New Roman]
If Not isExist Then
'
[/font]不存在則建立之

[font=Times New Roman]
Set QRY1 = DB1.CreateQueryDef(Name:="
[/font]查詢[font=新細明體]temp", sqltext:=QueryString)[/font]

[font=Times New Roman]
Else
'
[/font]存在,則設置查詢條件

[font=Times New Roman]
Set QRY1 = DB1.QueryDefs("
[/font]查詢[font=新細明體]temp")[/font]

[font=Times New Roman]
QRY1.Sql = QueryString
[/font]
[font=Times New Roman]
End If
[/font]
   
[font=Times New Roman]
Set RS1 = QRY1.OpenRecordset(dbOpenDynaset)
[/font]
   

[font=新細明體]
With Worksheets("plan")
[/font]



[font=Times New Roman]
'
[/font]下麵[font=Times New Roman]For--Next[/font]複製欄位字到第一行

[font=Times New Roman]
For iCols = 0 To RS1.Fields.Count - 1
[/font]
[font=Times New Roman]
.Cells(1, iCols + 1).Value = RS1.Fields(iCols).Name
[/font]
[font=Times New Roman]
Next
[/font]
[font=Times New Roman]
.Range("2:10000").ClearContents
[/font]
[font=Times New Roman]

.Range("A2").CopyFromRecordset RS1
'
[/font]將記錄集[font=Times New Roman] RS1 [/font]的記錄全部複製到工作表

[font=Times New Roman]
.Select
[/font]
[font=Times New Roman]
End With
[/font]
   
   
   
[font=Times New Roman]
DB1.Close
[/font]

[font=Times New Roman]End Sub[/font]


請幫忙改一下

注:這個是我從別人那裡抄來的!放在原文檔裡面另一個sheet裡面去執行,就OK,新建一個XLS就出現上面的錯誤。
我把能想到的方法都試過了!頭都大了!
就是沒有找到這是怎麼回事!。。。。。。

[[italic] 本帖最后由 xunmi_love 于 2008-1-10 11:13 编辑 [/italic]]
搜索更多相关主题的帖子: ado excel access 
2008-01-09 19:11
快速回复:excel連接access中的ado語句!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.072643 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved