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 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
|
Private Connexion
Public TYPEBASE As MyAdo
Public BASE
Public Server
Public Fichier
Public User
Public PassWord
Enum MyAdo
ACCESS97 = 1
ACCESS2000 = 2
ACCESS2012 = 1
ODBC = 4
ORACLE = 5
SQLSERVER2005 = 6
SQLServer2008R2 = 7
SQLite = 8
SQLite3 = 9
CSV = 10
ExcelSensTire = 11
ExcelAvecTire
End Enum
Private 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
If Trim("" & Fichier) = "" Then Fichier = BASE
Select Case TYPEBASE
Case ExcelAvecTire
GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BASE & ";Extended Properties=""Excel 12.0;HDR=YES;"""
Case ExcelSensTire
GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BASE & ";Extended Properties=""Excel 12.0;HDR=no;"""
Case ACCESS97
GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & Fichier
Case ACCESS2000
GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & ";Persist Security Info=False"
Case ACCESS2012
GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"
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 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=" & Fichier
GenereCSTRING = "Driver={SQLite ODBC (UTF-8) Driver};Database=" & Fichier & ";StepAPI=;Timeout="
Case SQLite3
GenereCSTRING = "Driver={SQLite3 ODBC Driver};Database=" & Fichier & ";LongNames=0;Timeout=4000;NoTXN=0;SyncPragma=NORMAL;StepAPI=0;"
Case CSV
GenereCSTRING = "ODBC;DBQ=" & Fichier & ";Driver={Microsoft Text Driver (*.txt; *.csv)}; " & "DriverId=27;Extensions=txt,csv,tab,asc;FIL=text;MaxBufferS"
Connex.Open
Case Else
GenereCSTRING = "PAS ASSEZ DE PARAMETRES RENSEIGNES !!!"
End Select
''MsgBox GenereCSTRING
'Response.End
End Function
Public Function OpenConnetion()
'Ouvre une connexion à la base de données.
'Dim Fso As New Scripting.FileSystemObject
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
' MsgBox Err.Description
End If
' Debug.Print Err.Description
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 Sql 'Replace(Sql, "%", "*")
Set OpenRecordSet = CreateObject("ADODB.Recordset")
' OpenRecordSet.LockType = adLockOptimistic
''MsgBox adLockOptimistic & vbcrlf & Err.Description
OpenRecordSet.Open Sql, Connexion, 1, 3
If Err Then
' MsgBox Err.Description
NbErr = NbErr + 1
If NbErr < 11 Then
Set OpenRecordSet = Nothing
End If
End If
Err.Clear
End Function
Public Function RetournConnection()
Set RetournConnection = Connexion
End Function
Public Function OpenCommand(Sql As String, TableauParam As Variant) As Object
ps.Value = 10
Set cm = CreateObject("ADODB.Command")
Set cm.ActiveConnection = Connexion
For i = 0 To UBound(TableauParam)
Set Param = CreateObject("ADODB.Parameter")
Param.Name = TableauParam(i).Name
Param.Type = TableauParam(i).TyParam
cm.Parameters.Append Param
Set Param = Nothing
Next
Set OpenCommand = cm.Execute
End Function
Public Function CloseRecordSet(Rs)
On Error Resume Next
Rs.Close
Set CloseRecordSet = Nothing
End Function
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
If Err = 0 Then
Execute = True
' Else
' 'MsgBox Err.Description
' Err.Clear
' NbErr = NbErr + 1
' If NbErr < 11 Then
'
' GoTo Reprise
' End If
Else
MsgBox Err.Description
End If
Err.Clear
End Function |
Partager