Questi metodi che potrebbero essere inseriti in un file di class, sono utili alla completa gestione di un database ovviamente senza grosse pretese.
Option Explicit
Public DB_ConnectioString As String
Public DB_User As String
Public DB_PWD As String
Public ErrNumber As String
Public ErrDescription As String
Public QueryString As String
Public sMessage As String
Dim CollQuery As Collection
Dim ChiaveQuery As Integer
Dim myCn As ADODB.Connection
'Metodo per raggruppare tutte le query da eseguire
Public Function AddQuery(ByVal SQL As String) As String
ChiaveQuery = ChiaveQuery + 1
CollQuery.Add SQL, CStr(ChiaveQuery)
QueryString = QueryString & SQL & vbNewLine
AddQuery = SQL
SQL = ""
End Function
'Apre una connessione
Public Function DB_OpenConnection(Optional sConnectionString, _
Optional sUser As String, Optional sPWD As String) As ADODB.Connection
On Error GoTo errHandler
Set myCn = New ADODB.Connection
If IsMissing(sConnectionString) Then
myCn.Open DB_ConnectioString, DB_User, DB_PWD
Else
myCn.Open sConnectionString, sUser, sPWD
End If
Set DB_OpenConnection = myCn
'Provider=MSDASQL.1;Persist Security Info=False;User ID=NomeUtente;
'PWD=Password;Data Source=NomeDB
Exit Function
errHandler:
App.LogEvent Err.Number & " " & Err.Description & " " & myCn.ConnectionString
ErrNumber = Err.Number
ErrDescription = Err.Description
End Function
'Esegue in una transazione le query precedentemente raggruppate
Public Function SendQuerys(Optional ConnectionString As String) As Boolean
Dim X As Long
Dim rs As ADODB.Recordset
Dim myConn As ADODB.Connection
ClearError
On Error GoTo ErrNumber
If ConnectionString = "" Then
Set myConn = New ADODB.Connection
myConn.ConnectionString = DB_ConnectioString
myConn.Open
Else
Set myConn = New ADODB.Connection
myConn.Open ConnectionString
End If
myConn.BeginTrans
Set rs = New ADODB.Recordset
QueryString = ""
For X = 1 To CollQuery.Count
'App.LogEvent CollQuery.Item(X), vbLogEventTypeInformation
QueryString = QueryString & CollQuery.Item(X) & vbNewLine
'Debug.Print QueryString
myConn.Execute CollQuery.Item(X)
Next
myConn.CommitTrans
Set CollQuery = Nothing
SendQuerys = True
ChiaveQuery = 0
Exit Function
ErrNumber:
App.LogEvent Err.Number & " " & Err.Description & " " & myConn.ConnectionString
SendQuerys = False
myConn.RollbackTrans
ErrNumber = Err.Number
ErrDescription = Err.Description
End Function
'Esegue una singola query con la possibilità di utilizzare anche una transazione
'se si vuole
Public Function RunSQL(ByVal SQL As String, Optional ByVal WithTransaction As Boolean, _
Optional ByVal ConnectionString As String) As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim myConn As ADODB.Connection
ClearError
On Error GoTo ErrNumberADO
If ConnectionString = "" Then
Set myConn = myCn
Else
Set myConn = New ADODB.Connection
myConn.Open ConnectionString
End If
If WithTransaction Then myConn.BeginTrans
'QueryString = SQL
Set rs = New ADODB.Recordset
rs.Open SQL, myConn
If WithTransaction Then myConn.CommitTrans
Set RunSQL = rs
Exit Function
ErrNumberADO:
App.LogEvent Err.Number & " " & Err.Description & " " & myConn.ConnectionString
If Not myConn Is Nothing Then
If WithTransaction Then
myConn.RollbackTrans
End If
End If
ErrNumber = Err.Number
ErrDescription = Err.Description
End Function
'Pulisce le variabili pubbliche per la gestione dell'errore
Private Sub ClearError()
ErrNumber = ""
ErrDescription = ""
End Sub
'Inizializza la collezione che raggruppa le query
Private Sub Class_Initialize()
Set CollQuery = New Collection
End Sub
