' dysorthographie ©
'**************************************************************************************
Public Enum separateur
Tabulation = 0
Virgule = 1
PoinVirgule = 2
Pip = 3
Fixe = 4
End Enum
Public Enum TypeCsv
Bit = 0 ' "Bit"
Bool = 1 ' "Boolean"
Bytes = 2 ' "Byte"
Short = 3 ' "Short"
Entier = 4 ' "Integer"
EntierLong = 5 ' "Long"
Signer = 6 ' "Single"
numerique = 7 ' "Double"
Reel = 8 ' "Float"
Date = 9 ' "DateTime"
Text = 10 ' "Text"
car = 11 ' "Char"
txt = 12 ' "Memo"
LonTXT = 14 ' "LongChar"
End Enum
' Permet de définir quel connecteur ODBC uilise pour la connexion à la base de données !
Public Enum MyConst
ACCESS
ODBC
ORACLE
SQLSERVER2005
SQLServer2008R2
SQLITE
SQLite3
CSV
Xls
MySQL
DBF
End Enum
'**************************************************************************************
'Permet de définir le type de champs
Public Enum AdodbTypeChamps
adEmpty = 0
adSmallInt = 2
adInteger = 3
adSingle = 4
adDouble = 5
adCurrency = 6
adDate = 7
adBSTR = 8
adIDispatch = 9
adError = 10
adBoolean = 11
adVariant = 12
adIUnknown = 13
adDecimal = 14
adTinyInt = 16
adUnsignedTinyInt = 17
adUnsignedSmallInt = 18
adUnsignedInt = 19
adBigInt = 20
adUnsignedBigInt = 21
adFileTime = 64
adGUID = 72
adBinary = 128
adChar = 129
adWChar = 130
adNumeric = 131
adUserDefined = 132
adDBDate = 133
adDBTime = 134
adDBTimeStamp = 135
adChapter = 136
adPropVariant = 138
adVarNumeric = 139
adVarChar = 200
adLongVarChar = 201
adVarWChar = 202
adLongVarWChar = 203
adVarBinary = 204
adLongVarBinary = 205
End Enum
Public Enum CharacterSet
ANSI = 0 'ANSI
UTF = 1 'UTF-8
End Enum
'***************************************************************************************
'Permet de sauvegarder le Nom ainsi que le type d'un champs
Public Type Champ
Name As String
TypeChamp As AdodbTypeChamps
End Type
'******************************************************************************************************************************************
'Retourne le ConetionString pour une connexion à une base de données ! _
Données d'entrées, information optionnel ! _
User : utilisateur {Login] _
Server : Répertoire et/ou nom du serveur {SQL server, Oracle, MySQL, CSV} _
Password mot de passe si nécessaires {Login} _
Base : Non dela base de données et/on chemein complet {SQL server, Oracle, MySQL, EXCEL, Sqlite} _
Titre : défini si le nom des champs figure sur la première ligne du document {MySQL, EXCEL }
'******************************************************************************************************************************************
Public Function GenereCSTRING(TYPEBASE As MyConst, _
Optional User As String, _
Optional Server As String, _
Optional Password As String, _
Optional Base As String, _
Optional Titre As Boolean = False, _
Optional IMEX As Boolean = True)
'Permet de générer le Cornec String
' ACCESS97
' ACCESS2000
' ACCESS2012
' ODBC
' ORACLE
' SQLSERVER2005
' SQLServer2008R2
' SQLITE
' SQLite3
' CSV
' Xls
' MySQL
Select Case TYPEBASE
Case Xls
GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Base & ";Extended Properties=""Excel 12.0;HDR=" & Array("No", "YES")(Abs(Titre)) & ";IMEX=" & Abs(IMEX) & ";"""
Case ACCESS2012
GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Base & ";Jet OLEDB:Database Password=" & Password & ";"
Case MySQL
GenereCSTRING = " DRIVER={MySQL ODBC 5.1 Driver};SERVER=" & Server & ";UID=" & User & ";DATABASE=" & Base & ";Password=" & Password
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=" & Base & ";LongNames=0;Timeout=4000;NoTXN=0;SyncPragma=NORMAL;StepAPI=0;"
Case CSV
GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Server & ";Extended Properties=""Text;HDR=" & Array("No", "YES")(Abs(Titre)) & ";FMT=Delimited;"""
Case DBF
GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Server & ";Extended Properties=dBASE IV;User ID=" & User & ";"
Case Else
GenereCSTRING = "PAS ASSEZ DE PARAMETRES RENSEIGNES !!!"
End Select
End Function
'******************************************************************************************************************************************
'Ici nous avons un requêter universel ! _
Il permet d'exécuter et/ou retourne une requête SQL {Exécution Direct Insert, Update, Delete ou de sélection} _
Paramètres : _
Sql : requête à exécuter _
cn : connectionSting _
Param() : paramètres de la requête par coupe de 2 _
Exeple: setMyRequête = ExecuteRequete(" Select * From MyTable where Champ1= ? ", " Champ1 ", "Valeure ")
'******************************************************************************************************************************************
Function ExecuteRequete(Sql As String, Cn As String, ParamArray Param() As Variant) As Object
Dim I As Integer
With CreateObject("ADODB.Command")
.ActiveConnection = Cn
.CommandType = 1
.CommandTimeout = 500
.CommandText = Sql
For I = LBound(Param) To UBound(Param) Step 2
Set prm = CreateObject("ADODB.Parameter")
prm.Name = Param(I): prm.Value = Param(I + 1): prm.Type = 12
.Parameters.Append prm
Next
Set ExecuteRequete = .Execute
End With
End Function
'******************************************************************************************************************************************
'Retourne la liste des tables de la base de données. _
Paramètre Connexion : ConectionString
'******************************************************************************************************************************************
Public Function ListeTables(Connexion As String) As String()
Dim TBL() As String, I As Integer
With CreateObject("ADOX.Catalog")
.ActiveConnection = Connexion
For Each T In .Tables
ReDim Preserve TBL(I)
TBL(I) = T.Name
I = I + 1
Next
End With
ListeTables = TBL
End Function
'******************************************************************************************************************************************
'Retourne la des champs d'une table de la base de données. _
Paramètre Connexion : ConectionString _
Table : Nomde la table
'******************************************************************************************************************************************
Public Function LiteChamps(Connexion As String, Table As String) As Champ()
Dim Ch() As Champ, I As Integer
With CreateObject("ADOX.Catalog")
.ActiveConnection = Connexion
For Each T In .Tables(Table).Columns
ReDim Preserve Ch(I)
Ch(I).Name = T.Name
Ch(I).TypeChamp = T.Type
I = I + 1
Next
End With
LiteChamps = Ch
End Function
'******************************************************************************************************************************************
Public Sub ShemaIn(Fichier As String, _
Server As String, _
FichertVierge As Boolean, _
Kill As Boolean, _
Delimited As separateur, _
Character As CharacterSet, _
ColNameHeader As Boolean, _
DateTimeFormat As String, _
DecimalSymbol As String, _
ParamArray Champ() As Variant)
Dim txt As String, DLM, Tp
Tp = Array("Bit", "Boolean", "Byte", "Short", "Integer", "Long", "Single", "Double", "Float", "DateTime", "Text", "Char", "Memo", "LongChar")
DLM = Array("TabDelimited", "CSVDelimited", "Delimited(;)", "Delimited(|)", "FixedLength")
txt = "[" & Fichier & "]" & vbCrLf & "Format= " & DLM(Delimited) & vbCrLf & _
"CharacterSet=" & Array("ANSI", "UTF-8")(Character) & vbCrLf & _
"ColNameHeader=" & Array("False", "True")(Abs(ColNameHeader)) & vbCrLf & _
"DateTimeFormat=" & DateTimeFormat & vbCrLf & _
"DecimalSymbol=" & Chr(34) & DecimalSymbol & Chr(34) & vbCrLf
For Each F In Champ
For I = LBound(F, 1) To UBound(F, 1)
txt = txt & F(I, 1) & "=" & F(I, 2) & " " & Tp(F(I, 3)) & " Width " & F(I, 4) & vbCrLf
Next
Next
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(Server & "\schema.ini", IIf(Kill, 2, 8), True)
.Write txt
.Close
End With
If FichertVierge Then
With .OpenTextFile(Server & "\" & Fichier, 2, True)
.Close
End With
End If
End With
End Sub
