Option ExplicitPublic Function ConnectString() As String
'returns a DB ConnectString
Dim ASTR As String' ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ASTR & ";Persist Security Info=False"
ConnectString = "Driver={Microsoft Access Driver (*.mdb)};DBQ=" & ASTR & ";ReadOnly=True"
End Function
Public Function ExecuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset
'executes SQL and returns Recordset
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sTokens() As String
On Error GoTo ExecuteSQL_Error
sTokens = Split(SQL)
Set cnn = New ADODB.Connection
cnn.Open ConnectString
If InStr("INSERT,DELETE,UPDATE", _
UCase$(sTokens(0))) Then
cnn.Execute SQL
MsgString = sTokens(0) & _
" query successful"
Else
Set rst = New ADODB.Recordset
rst.Open Trim$(SQL), cnn, _
adOpenKeyset, _
adLockOptimistic
'rst.MoveLast 'get RecordCount
Set ExecuteSQL = rst
MsgString = "查询到" & rst.RecordCount & _
" 条记录 "
End If
ExecuteSQL_Exit:
Set rst = Nothing
Set cnn = Nothing
Exit Function
ExecuteSQL_Error:
MsgString = "查询错误: " & _
Err.Description
Resume ExecuteSQL_Exit
End Function
Public Sub EnterToTab(Keyasc As Integer)
If Keyasc = 13 Then
SendKeys "{TAB}"
End If
End Sub
'**********************************************************
' 获得数据库路径
' 本例数据库保存在程序目录下的DBS子目录中,名为db1.mdb
'**********************************************************
Public Function GetDatabasePath() As String
Dim sPath As String
If Right$(App.Path, 1) = "\" Then
sPath = App.Path + "dbs\"
Else
sPath = App.Path + "\dbs\"
End If
GetDatabasePath = sPath + "filedata.mdb"
End FunctionPrivate Sub Command1_Click()
Dim txtsql As String
Dim msgtext As String
Dim mrc As ADODB.Recordset
txtsql = "select * from filelist"
Set mrc = ExecuteSQL(txtsql, msgtext)
Debug.Print msgtext
End Sub红色处,用注释的那句,提示“查询错误”
用另一句,提示“操作已取消”。请问是怎么回事
'returns a DB ConnectString
Dim ASTR As String' ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ASTR & ";Persist Security Info=False"
ConnectString = "Driver={Microsoft Access Driver (*.mdb)};DBQ=" & ASTR & ";ReadOnly=True"
End Function
Public Function ExecuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset
'executes SQL and returns Recordset
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sTokens() As String
On Error GoTo ExecuteSQL_Error
sTokens = Split(SQL)
Set cnn = New ADODB.Connection
cnn.Open ConnectString
If InStr("INSERT,DELETE,UPDATE", _
UCase$(sTokens(0))) Then
cnn.Execute SQL
MsgString = sTokens(0) & _
" query successful"
Else
Set rst = New ADODB.Recordset
rst.Open Trim$(SQL), cnn, _
adOpenKeyset, _
adLockOptimistic
'rst.MoveLast 'get RecordCount
Set ExecuteSQL = rst
MsgString = "查询到" & rst.RecordCount & _
" 条记录 "
End If
ExecuteSQL_Exit:
Set rst = Nothing
Set cnn = Nothing
Exit Function
ExecuteSQL_Error:
MsgString = "查询错误: " & _
Err.Description
Resume ExecuteSQL_Exit
End Function
Public Sub EnterToTab(Keyasc As Integer)
If Keyasc = 13 Then
SendKeys "{TAB}"
End If
End Sub
'**********************************************************
' 获得数据库路径
' 本例数据库保存在程序目录下的DBS子目录中,名为db1.mdb
'**********************************************************
Public Function GetDatabasePath() As String
Dim sPath As String
If Right$(App.Path, 1) = "\" Then
sPath = App.Path + "dbs\"
Else
sPath = App.Path + "\dbs\"
End If
GetDatabasePath = sPath + "filedata.mdb"
End FunctionPrivate Sub Command1_Click()
Dim txtsql As String
Dim msgtext As String
Dim mrc As ADODB.Recordset
txtsql = "select * from filelist"
Set mrc = ExecuteSQL(txtsql, msgtext)
Debug.Print msgtext
End Sub红色处,用注释的那句,提示“查询错误”
用另一句,提示“操作已取消”。请问是怎么回事
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货