Knowledge Base

‘*************************************************************************************

‘———————
‘Connection parameters
‘———————
Const cServer = “.\SQLSERVER” ‘Server SQL instance
Const cDB = “DbTest” ‘Database name
Const cLogin = “sa” ‘login for SQL Server
Const cPwd = “mypassword” ‘pwd for SQL Server

‘To switch to SQL Server authentification (use of cLogin and cPwd)
Const cUseWindowsAuthentification = True

‘———————————————–
‘General constant
Const adOpenStatic = 3
Const adOpenDynamic = 4
Const adLockOptimistic = 3
Const adUseClient = 3

‘Connections objets
Dim oCnx As New ADODB.Connection ‘Connection
Dim oRst As New ADODB.Recordset ‘Recordset

‘———————————————–
‘Fonction that sends a request to a database
‘———————————————–
Private Sub BtnCnx_Click()
Dim aQueryResult As Variant
Dim bRet As Boolean

If Connection = True Then
bRet = SendRequest(“SELECT top 20 Name,ChampA,ChampB FROM Table_1 order by ChampB”, aQueryResult)
bRet = SendCommand(“INSERT INTO Table_1 (Name,ChampA,ChampB) VALUES(‘TOTO’, NULL, 33)”)
Disconnection
End If

End Sub

‘———————————————–
‘function that establishes a database connection
‘———————————————–
Private Function Connection() As Boolean

On Error GoTo TRAP_Error

‘Connection string for SQL Server
oCnx.Provider = “SQLNCLI10” ‘May require changing depending on database version
oCnx.ConnectionString = “Server=” & cServer & “;Database=” & cDB & “;”

‘Authentification
If cUseWindowsAuthentification = True Then
oCnx.ConnectionString = oCnx.ConnectionString & “Integrated Security=SSPI”
Else
oCnx.ConnectionString = oCnx.ConnectionString & “Uid=” & cLogin & “;Pwd=” & cPwd
End If

‘Open connection
oCnx.Open

‘Return of function
Connection = True
Exit Function

TRAP_Error:
‘Error management
If Err.Number <> -2147467259 Then
MsgBox “You met an error by connecting database.” & vbCrLf & “Error Number : ” & Err.Number & vbCrLf & Err.Description
Else
MsgBox “Error in function “”Connection”” :” & vbCrLf & Err.Description
End If

‘Close connection if it exists
If oCnx.State <> 0 Then oCnx.Close

‘Return of function
Connection = False
End Function

‘———————————————-
‘function that disconnects a connected database
‘———————————————-
Private Sub Disconnection()
If oRst.State <> 0 Then oRst.Close
If oCnx.State <> 0 Then oCnx.Close
End Sub

‘————————————————–
‘function that send a request that expects a result
‘————————————————–
Private Function SendRequest(ByVal pSQLRequest As String, ByRef aResult As Variant) As Boolean

Dim iNbRow As Integer ‘Number of resulted records
Dim iNbCol As Integer ‘Number of resulted fields
Dim iCurrRow As Integer ‘Used to pase records
Dim iCurrCol As Integer ‘Used to pase fields

On Error GoTo TRAP_Error

‘Connection must be opened
If oCnx.State = 1 Then

‘Send request
oRst.Open pSQLRequest, oCnx, adOpenStatic, adLockOptimistic

‘If there are any records
If oRst.RecordCount <> 0 Then

iNbRow = oRst.RecordCount – 1 ‘Number of records (rows)
iNbCol = oRst.Fields.Count – 1 ‘Number of fields (columns)

‘set result table with good limits
ReDim aResult(0 To iNbRow, 0 To iNbCol)

oRst.MoveFirst ‘Pointer on the 1st record
iCurrRow = 0 ‘Pointer to the 1st row of result table

While Not oRst.EOF ‘Parse all records
For iCurrCol = 0 To iNbCol ‘For each column

If (Not oRst.Fields(iCurrCol).Value = “NULL”) Then ‘If data is not NULL => insert in result table
aResult(iCurrRow, iCurrCol) = oRst.Fields(iCurrCol).Value
End If
Next

‘Next record (DB request result) + next row (result table)
iCurrRow = iCurrRow + 1
oRst.MoveNext
Wend

‘Close recordset if necessary
If oRst.State = 1 Then oRst.Close

‘Set return
SendRequest = True

Else
MsgBox “Database is not connected.” & vbCrLf & “It is not possible to send a request.”
SendRequest = False
End If
End If

Exit Function

TRAP_Error:
MsgBox “Error in function “”SendRequest”” :” & vbCrLf & Err.Description
SendRequest = False
End Function

‘————————————————–
‘function that send a command (expects no result)
‘————————————————–
Private Function SendCommand(pSQLRequest) As Boolean

On Error GoTo TRAP_Error

‘Connection must be opened
If oCnx.State = 1 Then

‘Send request
oRst.Open pSQLRequest, oCnx, adOpenStatic, adLockOptimistic

‘Close recordset if necessary
If oRst.State = 1 Then oRst.Close

SendCommand = True
Else
MsgBox “Database is not connected.” & vbCrLf & “It is not possible to send a request.”
SendCommand = False
End If

Exit Function

TRAP_Error:
MsgBox “Error in function “”SendCommand”” :” & vbCrLf & Err.Description
SendCommand = False
End Function

Download attachments: Mimic_PcVue10