Option Explicit
Dim udlConn As String
Private Function setConn(ByRef errConn As Boolean, ByRef errDesc As String, ByRef errNumber As Long) As ADODB.Connection
On Error GoTo errSetConn
Dim cn As New ADODB.Connection
Dim ConnString As String
Dim pass As String
pass = getDBPassword
'----- Initialize the Connection String and retrieve the Password from dbAccess.ini -----
ConnString = "Provider=MSDataShape;" & _
"Data Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & udlConn & ";Jet OLEDB:Database Password=" & pass
If errConn = False Then
cn.CursorLocation = adUseClient
cn.ConnectionString = ConnString
cn.Open
Set setConn = cn
Else
Err.Description = errDesc
GoTo errSetConn
End If
Set cn = Nothing
Exit Function
errSetConn:
Set cn = Nothing
errDesc = Err.Description
errNumber = Err
errConn = True
End Function
Public Function getRS(ByVal strSQL As String, _
ByRef isException As Long, ByRef errDesc As String) As ADODB.Recordset
'--- Initialize the recordset---
On Error GoTo errGetRS
Dim rs As New ADODB.Recordset
Dim errConn As Boolean
Dim errNumber As Long
rs.CursorLocation = adUseClient
rs.CursorType = adOpenDynamic
rs.ActiveConnection = setConn(errConn, errDesc, errNumber)
If errConn = True Then
Err.Description = errDesc
GoTo errGetRS
Else
rs.Open strSQL
Set getRS = rs
End If
Set rs = Nothing
Exit Function
errGetRS:
errDesc = Err.Description
isException = errNumber
End Function
Public Function addRecord(ByVal tableName As String, _
ByVal fieldList As String, _
ByVal valueList As String, _
ByRef errDesc As String) As Boolean
'--- Function adding Records in the Database ----
On Error GoTo errAddRecord
Dim isException As Long
Dim strSQL As String
strSQL = "INSERT INTO " & Trim(tableName) & "(" & Trim(fieldList) & ") VALUES(" & Trim(valueList) & ")"
getRS strSQL, isException, errDesc
If isException = 0 Then
addRecord = True
Else
Err.Description = errDesc
GoTo errAddRecord
End If
Exit Function
errAddRecord:
errDesc = Err.Description
addRecord = False
End Function
Public Function editRecord(ByVal tableName As String, _
ByVal setList As String, _
ByVal cond As String, ByRef errDesc As String) As Boolean
On Error GoTo errEditRecord
Dim isException As Long
Dim strSQL As String
'---- Function to Edit Records ----
strSQL = "UPDATE " & Trim(tableName) & " SET " & Trim(setList) & " WHERE " & Trim(cond)
getRS strSQL, isException, errDesc
Debug.Print strSQL
If isException = 0 Then
editRecord = True
Else
Debug.Print errDesc
Err.Description = errDesc
GoTo errEditRecord
End If
Exit Function
errEditRecord:
errDesc = Err.Description
editRecord = False
End Function
Public Function deleteRecord(ByRef errDesc As String, ByVal tableName As String, _
Optional ByVal cond) As Boolean
On Error GoTo errDelRecord
Dim isException As Long
Dim strSQL As String
'----- Function to Delete a set/ certain Recordset-------
If IsMissing(cond) Then
strSQL = "DELETE FROM " & Trim(tableName)
Else
strSQL = "DELETE FROM " & Trim(tableName) & " WHERE " & Trim(cond)
End If
getRS strSQL, isException, errDesc
If isException = 0 Then
deleteRecord = True
Else
Err.Description = errDesc
GoTo errDelRecord
End If
Exit Function
errDelRecord:
errDesc = Err.Description
deleteRecord = False
End Function
Public Property Let dbProp(ByVal dbCn As String)
If dbCn <> "" Then
udlConn = dbCn
Else
udlConn = ""
End If
End Property