1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
| Public cnx As ADODB.Connection
Sub auto_open()
Dim strPath As String
Application.Goto Reference:="StrPath"
strPath = ActiveCell
If Len(Dir(strPath)) > 0 Then
Set cnx = New ADODB.Connection
ConnectDB cnx, strPath
Else
MsgBox "La base n'a pas pu être trouvée" & vbCrLf & _
strPath & vbCrLf & _
"n'est pas un chemin valide.", vbCritical + vbOKOnly
End If
End Sub
Sub ConnectDB(ByRef cnx As ADODB.Connection, ByVal strPath As String)
'Définition du pilote de connexion
cnx.Provider = "Microsoft.Jet.Oledb.4.0"
'Définition de la chaîne de connexion
cnx.ConnectionString = strPath
'Ouverture de la base de données
cnx.Open
End Sub
Public Function xRetrieve(Optional ByVal whatEI As String = vbNullString, _
Optional ByVal Mois As Integer = 0)
Dim rec As New ADODB.Recordset
Dim strSQL As String
strSQL = "SELECT countEI AS COMPTE_EI " & _
"FROM [QueryEtat] WHERE 1=1 "
If Len(whatEI) > 0 Then
strSQL = strSQL & " and ([what] = '" & whatEI & "')"
End If
If Mois > 0 Then
strSQL = strSQL & " And ([moisEI] = " & Mois & ")"
End If
Dim rst As New ADODB.Recordset
rst.Open strSQL, cnx
On Error GoTo errH01
rst.MoveFirst
xRetrieve = CDbl(rst("COMPTE_EI"))
rst.Close
Set rst = Nothing
Exit Function
errH01:
Err.Clear
xRetrieve = 0
rst.Close
Set rst = Nothing
End Function |
Partager