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 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209
| Private Connexion
Private TYPEBASE As MyAdo
Private BASE
Private Server
Private User
Private Password
Private Port
Private TCP
Public Enum MyAdo
ACCESS97 = 1
ACCESS2000 = 2
ACCESS2012 = 1
ODBC = 4
Oracle = 5
OracleTcpIp = 13
SQLSERVER_NT4 = 12
SQLSERVER2005 = 6
SQLServer2008R2 = 7
SQLite = 8
SQLite3 = 9
CSV = 10
Excel8 = 11
End Enum
Public Property Get MonTCP() As String
MonTCP = TCP
End Property
Public Property Let MonTCP(ByVal TCP_ As String)
MonTCP = TCP_
End Property
Public Property Get MonPort() As String
MonPort = Port
End Property
Public Property Let MonPort(ByVal Port_ As String)
MonPort = Port_
End Property
Public Property Get MonPassword() As String
MonPassword = Password
End Property
Public Property Let MonPassword(ByVal Password_ As String)
Password = Password_
End Property
Public Property Get MonUser() As String
MonUser = User
End Property
Public Property Let MonUser(ByVal User_ As String)
User = User_
End Property
Public Property Get MonServer() As String
MonServer = Server
End Property
Public Property Let MonServer(ByVal MonServer_ As String)
Server = MonServer_
End Property
Public Property Get Database() As String
Database = BASE
End Property
Public Property Let Database(ByVal Database_ As String)
BASE = Database_
End Property
Public Property Get BASETYPE() As MyAdo
BASETYPE = TYPEBASE
End Property
Public Property Let BASETYPE(ByVal BASETYPE_ As Long)
TYPEBASE = BASETYPE_
End Property
Public Function GenereCSTRING()
'Permet de générer le Cornec String
'1 - ACCESS 97
'2 - ACCESS 2000
'3 - ACCESS 2012
'4 - ODBC
'5 - ORACLE
'6 - SQL SERVER 2005
'7 - SQL Server 2008 R2
'8 - SQLite
'9 - SQLite3
Select Case TYPEBASE
Case ACCESS97
GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & BASE
Case ACCESS2000
GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & BASE & ";Persist Security Info=False"
Case ACCESS2012
GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BASE & ";"
Case ODBC
GenereCSTRING = "Provider=MSDASQL.1;Password=" & Password & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & BASE
Case Oracle
GenereCSTRING = "Provider=OraOLEDB.Oracle.1;Password=" & Password & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & BASE
Case OracleTcpIp
GenereCSTRING = "MyBase.WORLD=(DESCRIPTION=(ADDRESS=(PROTOCOL=" & TCP & ")(HOST=" & Server & ")(PORT=" & Port & "))(CONNECT_DATA=(SERVICE_NAME=" & BASE & ")))"
Case SQLSERVER_NT4
GenereCSTRING = "Provider=SQLOLEDB.1;Password=" & Password & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & BASE & ";Data Source=" & Server
Case SQLSERVER2005
GenereCSTRING = "Provider=SQLOLEDB.1;Password=" & Password & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & BASE & ";Data Source=" & Server
Case SQLServer2008R2
GenereCSTRING = "Provider=SQLNCLI;Server=" & Server & ";Database=" & BASE & ";UID=" & User & ";PWD=" & Password & ";"
Case SQLite
GenereCSTRING = "Provider=OleSQLite.SQLiteSource.3; Data Source=" & BASE
GenereCSTRING = "Driver={SQLite ODBC (UTF-8) Driver};Database=" & BASE & ";StepAPI=;Timeout="
Case SQLite3
GenereCSTRING = "Driver={SQLite3 ODBC Driver};Database=" & BASE & ";LongNames=0;Timeout=4000;NoTXN=0;SyncPragma=NORMAL;StepAPI=0;"
Case CSV
GenereCSTRING = "ODBC;DBQ=" & Server & ";Driver={Microsoft Text Driver (*.txt; *.csv)}; " & "DriverId=27;Extensions=txt,csv,tab,asc;FIL=text;MaxBufferS"
Case Excel8
GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & BASE & ";Extended Properties=Excel 8.0;"
Case Else
GenereCSTRING = "PAS ASSEZ DE PARAMETRES RENSEIGNES !!!"
End Select
End Function
Public Function RetournRep()
Dim t
t = Split(BASE, "\")
RetournRepFichier = Replace(BASE, t(UBound(t)), "")
End Function
Public Function RetournFichier()
Dim t
t = Split(BASE, "\")
RetournFichier = t(UBound(t))
End Function
Public Function OpenConnetion()
'Ouvre une connexion à la base de données.
OpenConnetion = False
On Error Resume Next
Dim ConnecString
Dim NbErr
Set Connexion = CreateObject("ADODB.Connection")
Connexion.Open GenereCSTRING 'ConnecString
If Err = 0 Then
OpenConnetion = True
Connexion.CommandTimeout = 14400
Else
Debug.Print Err.Descriptio
End If
Err.Clear
On Error GoTo 0
End Function
Public Function CloseConnection()
'Referme la connexion
CloseConnection = False
On Error Resume Next
Connexion.Close
Set Connexion = Nothing
If Err = 0 Then
CloseConnection = True
End If
Err.Clear
On Error GoTo 0
End Function
Public Function OpenRecordSet(Sql)
'Retourne un RecordeSet
On Error Resume Next
Dim RS
Dim NbErr
Err.Clear
If Connexion.State = 0 Then
OpenConnetion
End If
Debug.Print Replace(Sql, "%", "*")
Set OpenRecordSet = CreateObject("ADODB.Recordset")
OpenRecordSet.Open Sql, Connexion, 1, 3
If Err Then
MsgBox Err.Description
If NbErr < 11 Then
Set OpenRecordSet = Nothing
End If
End If
Err.Clear
On Error GoTo 0
End Function
Public Function RetournConnection()
Set RetournConnection = Connexion
End Function
'Pas fonctionel
Public Function OpenRecordSetParametre(Sql, Param)
Dim Commande
Dim Params
Set Commande = CreateObject("ADODB.Command")
Dim MyParameter
Set MyParameter = CreateObject("ADODB.Parameter")
Set Commande.ActiveConnection = Connexion
Commande.CommandText = "select Requête2.* from Requête2;"
Commande.CommandType = adCmdText
Set MyParameter = Commande.CreateParameter("[NumJob]", adNumeric)
MyParameter.Value = 10
Commande.Parameters.Append MyParameter
Set Rs2 = Commande.Execute
End Function
'Cloture le RecordSet
Public Function CloseRecordSet(RS)
On Error Resume Next
RS.Close
Set CloseRecordSet = Nothing
On Error GoTo 0
End Function
'Pour les requêtes directe
Public Function Execute(Sql)
Execute = False
On Error Resume Next
Dim NbErr
Reprise:
If Connexion.State = 0 Then
OpenConnetion
End If
Debug.Print Sql
Connexion.Execute Sql
Err.Clear
On Error GoTo 0
End Function |
Partager