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
|
Public Const ODBC_ADD_DSN As Long = 1 ' Ajoute DSN utilisateur
Public Const ODBC_ADD_SYS_DSN As Long = 4 ' Ajoute DSN système
Public Const ODBC_REMOVE_DSN As Long = 3 ' Supprime DSN utilisateur
Public Const ODBC_REMOVE_SYS_DSN As Long = 6 ' Supprime DSN système
Public Declare Function SQLConfigDataSource Lib "odbccp32.dll" _
(ByVal hWndParent As Long, ByVal fRequest As Long, _
ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
Public Const SQL_SUCCESS As Long = 0
Public Const SQL_SUCCESS_WITH_INFO As Long = 1
Public Declare Function SQLInstallerError Lib "odbccp32.dll" _
(ByVal iError As Integer, _
ByRef pfErrorCode As Long, _
ByVal lpszErrorMsg As String, _
ByVal cbErrorMsgMax As Long, _
ByRef pcbErrorMsg As Long) As Long
Public Enum dsnTypes
dsnUser = 0
dsnSystem = 1
End Enum
' ---------------------------------------------------------
' Function apiRegDB
' ---------------------------------------------------------
' Entrée:
' ======
' strDSN .............. : Nom de la source de données à créer
' strDriver ........... : Nom du pilote ODBC
' strAttributes ....... : Paramètres
' lngDSNtype .......... : dsnUser -> crée DSN utilisateur
' dsnSystem -> crée DSN système
' blnDeleteBeforeCreate : True -> supprime DSN avant création
'Retourne:
' ========
' True si succès, sinon False
' ---------------------------------------------------------
Function apiRegDB(strDSN As String, strDriver As String, strAttributes As String, _
Optional lngDSNtype As dsnTypes = dsnTypes.dsnUser, _
Optional blnDeleteBeforeCreate As Boolean = False) As Boolean
Dim retVal As Long, strAttr As String, strErrMsg As String
Dim Add_DSN As Long, Rmv_DSN As Long
Dim pfErrorCode As Long, pcbErrorMsg As Long, lpszErrorMsg As String, i As Integer
If lngDSNtype = dsnSystem Then
' Source de données système
Add_DSN = ODBC_ADD_SYS_DSN
Rmv_DSN = ODBC_REMOVE_SYS_DSN
Else
' Source de données utilisateur
Add_DSN = ODBC_ADD_DSN
Rmv_DSN = ODBC_REMOVE_DSN
End If
If blnDeleteBeforeCreate Then
' Supprime source de données si déjà créée
strAttr = "DSN=" & strDSN & vbNullChar & vbNullChar
retVal = SQLConfigDataSource(0, Rmv_DSN, strDriver, strAttr)
End If
' Construit chaîne d'attributs mot-clé=valeur
' Chaque paire mot-clé/valeur est terminée par un caractère nul
strAttr = "DSN=" & strDSN & vbNullChar
strAttr = strAttr & strAttributes
' Terminaison de la chaîne
strAttr = strAttr & vbNullChar
' Crée source de données
retVal = SQLConfigDataSource(0, Add_DSN, strDriver, strAttr)
If retVal = 0 Then
i = 0
Do
i = i + 1
lpszErrorMsg = String(2048, vbNullChar)
retVal = SQLInstallerError(i, pfErrorCode, lpszErrorMsg, 2047, pcbErrorMsg)
If retVal = SQL_SUCCESS_WITH_INFO Then retVal = SQL_SUCCESS
If retVal = SQL_SUCCESS Then
If Len(strErrMsg) > 0 Then strErrMsg = strErrMsg & vbCrLf & vbCrLf
strErrMsg = strErrMsg & Left(lpszErrorMsg, pcbErrorMsg)
End If
Loop Until (retVal <> SQL_SUCCESS Or i = 8)
MsgBox strErrMsg, , "SQLConfigDataSource"
apiRegDB = False
Else
apiRegDB = True
End If
End Function
Sub apiRegDSN_mysql2()
Dim strDSN As String, strAttr As String, strODBCDrv As String
Dim blnSuccess As Boolean
' Nom de la source de données ODBC
strDSN = "ESSAI MySQL"
' Nom du pilote ODBC
strODBCDrv = "MySQL ODBC 5.1 Driver"
' Attributs
strAttr = "SERVER=188.165.217.217" & vbNullChar & "DATABASE=vetshop2" & vbNullChar
strAttr = strAttr & "Description=ESSAI DSN MySQL" & vbNullChar
strAttr = strAttr & "OPTION=3" & vbNullChar
strAttr = strAttr & "UID=aaaaa" & vbNullChar
strAttr = strAttr & "PWD=bbbbb" & vbNullChar
blnSuccess = apiRegDB(strDSN, strODBCDrv, strAttr, dsnSystem, True)
Dim strConn As String, db As DAO.Database, td As DAO.TableDef, strIndex As String
Set db = CurrentDb
' Chaîne de connexion
strConn = "ODBC;" & _
"DSN=ESSAI MySQL;" & _
"UID=aaaaa;PWD=bbbbb"
' Création nouvelle définition de table
Set td = db.CreateTableDef("vete")
' Optionnel : Sauver mot de passe
td.Attributes = td.Attributes Or dbAttachSavePWD
' Chaîne de connexion ODBC pour DAO
td.Connect = strConn
' Nom de la table source
td.SourceTableName = "vete"
' Ajouter à la collection
db.TableDefs.Append td
Set td = Nothing
Set db = Nothing
' Actualiser fenêtre base de données pour que la nouvelle table apparaisse
Application.RefreshDatabaseWindow
Set db = CurrentDb
Set db = CurrentDb
' Ajout index clé primaire
strIndex = "CREATE UNIQUE INDEX __uniqueindex " & _
"ON vete ([id] ASC) WITH PRIMARY"
db.Execute strIndex, dbFailOnError
End Sub |
