module1.bas

自考软件工程_宋瑞峰 自考软件工程_宋瑞峰

Attribute VB_Name = "Module1"
'API函数声明
Public Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1

'******************************************
'****  函数说明：执行程序中的SQL语句   ****
'******************************************
Public Function ExecuteSQL(ByVal SQL As String) As ADODB.Recordset
'定义数据连接对象
Dim conn As ADODB.Connection
'定义数据记录集对象
Dim rs As ADODB.Recordset
Dim sTemp() As String

'错误处理
On Error GoTo ExecuteSQL_Error

sTemp = Split(SQL)

'创建数据连接对象
Set conn = New ADODB.Connection
'打开数据连接对象
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\book.mdb;Persist Security Info=False"

'如果是删除、更新、插入
If InStr("INSERT,UPDATE,DELETE", UCase$(sTemp(0))) Then
    conn.Execute SQL
Else
    '创建数据记录集对象
    Set rs = New ADODB.Recordset
    rs.Open SQL, conn, adOpenKeyset, adLockOptimistic
    Set ExecuteSQL = rs
End If



'退出函数，清除相关对象
ExecuteSQL_Exit:
  Set rs = Nothing
  Set conn = Nothing
  Exit Function
  
'错误处理
ExecuteSQL_Error:
  MsgBox "数据库执行错误: " & err.Description, vbCritical + vbOKOnly, "错误"
  Resume ExecuteSQL_Exit
End Function