moddatabase.bas

project on Video rental system

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