?? moddatabase.bas
字號:
Attribute VB_Name = "modDatabase"
Option Explicit
Public Function GetConnectionString() As String
GetConnectionString = "Provider=Microsoft.JET.OLEDB.3.51;Data Source=" & App.Path & "\video.mdb"
End Function
Public Function RunSelectQuery(ByVal strSQL As String, ByRef varResult As Variant) As Long
On Error GoTo SQLERR
Dim cnnTemp As ADODB.Connection
Dim rstTemp As ADODB.Recordset
Set cnnTemp = New ADODB.Connection
cnnTemp.CursorLocation = adUseClient
cnnTemp.Open GetConnectionString
Set rstTemp = New ADODB.Recordset
' For client-side connections, the cursor type is adOpenStatic
rstTemp.Open strSQL, cnnTemp
' If there are no records, the BOF and EOF property settings are True
If rstTemp.BOF And rstTemp.EOF Then
RunSelectQuery = 0
Else
varResult = rstTemp.GetRows()
RunSelectQuery = rstTemp.RecordCount
End If
If rstTemp.State = adStateOpen Then
rstTemp.Close
End If
If cnnTemp.State = adStateOpen Then
cnnTemp.Close
End If
Set rstTemp = Nothing
Set cnnTemp = Nothing
Exit Function
SQLERR:
Dim objErr As ADODB.Error, strMsg As String
Select Case Err.Number
Case &H80040E10
strMsg = "The column name used does not exist. Check the column names in a database against your query string"
Case Else
strMsg = "VB Error: " & Err.Description
End Select
strMsg = strMsg & vbCrLf
For Each objErr In cnnTemp.Errors
strMsg = strMsg & "Source: " & objErr.Source & " (" & objErr.SQLState & ")" & vbCrLf & "Description: " & objErr.Description & " (" & Hex$(objErr.Number) & ")" & vbCrLf
Next
MsgBox strMsg
End Function
' for INSERT, UPDATE and DELETE
Public Function RunActionQuery(ByVal strSQL As String) As Long
On Error GoTo SQLERR
Dim cnnTemp As ADODB.Connection
Dim lRecordsAffected As Long
Set cnnTemp = New ADODB.Connection
'cnnTemp.CursorLocation = adUseClient
cnnTemp.Open GetConnectionString
cnnTemp.Execute strSQL, lRecordsAffected, adCmdText + adExecuteNoRecords
Set cnnTemp = Nothing
RunActionQuery = lRecordsAffected
Exit Function
SQLERR:
Dim objErr As ADODB.Error, strMsg As String
strMsg = "VB Error: " & Err.Description & vbCrLf
' If the provider generates error,
' these will be populated in the ADO Errors Collection.
For Each objErr In cnnTemp.Errors
strMsg = strMsg & "Source: " & objErr.Source & " (" & objErr.SQLState & ")" & vbCrLf & "Description: " & objErr.Description & " (" & Hex$(objErr.Number) & ")" & vbCrLf
Next
MsgBox strMsg
End Function
Public Function ConvertToString(v As Variant) As String
If IsNull(v) Then
ConvertToString = ""
Else
ConvertToString = CStr(v)
End If
End Function
Public Function ConvertToField(v As Variant, ByVal bNumeric As Boolean) As String
Dim strTemp As String
strTemp = Trim$(v)
If Len(strTemp) > 0 Then
ConvertToField = strTemp
Else
If bNumeric Then
ConvertToField = 0
Else
ConvertToField = " "
End If
End If
End Function
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -