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
| Private Sub Commande0_Click()
Dim Wksp As DAO.Workspace, Conn As DAO.Connection, strODBCconn As String
Dim rs As DAO.Recordset, strSQL As String, lgIdFournisseur As Long
Dim strUID As String, strPWD As String
Dim errX As DAO.Error, strErrMsg As String
Dim tdfNew As TableDef
Dim prpLoop As Property
strUID = "admin"
strPWD = "pwdok"
On Error GoTo ERRH
Set Wksp = DBEngine.CreateWorkspace("MonWkspODBC", strUID, strPWD, dbUseODBC)
strODBCconn = "ODBC;" & _
"DSN=DSN_TEST;" & _
"UID=" & strUID & ";PWD=" & strPWD & ";" & _
"WSID=" & Environ("COMPUTERNAME") & ";" & _
"DATABASE=BASE_OK;" & _
"Network=DBMSSOCN"
Set Conn = Wksp.OpenConnection("DSN_TEST", dbDriverNoPrompt, False, strODBCconn)
Set tdfNew = Conn.Database.CreateTableDef("Thermo_test")
With tdfNew
.Fields.Append .CreateField("Ligne", dbText)
.Fields.Append .CreateField("Per", dbText)
.Fields.Append .CreateField("Graph", dbText)
.Fields.Append .CreateField("Modif", dbBoolean)
End With
ERRH:
strErrMsg = "Erreur N° " & CStr(Err.Number) & " : " & Err.Description
Select Case Err.Number
Case 3146, 3151, 3154, 3155, 3156, 3157, 3231, 3232, 3234, 3225, 3238, 3247, 3254
strErrMsg = strErrMsg & vbCrLf & vbCrLf & _
">>> Erreurs complémentaires DAO :" & vbCrLf & _
"======================"
For Each errX In DBEngine.Errors
strErrMsg = strErrMsg & vbCrLf & Format(errX.Number, "00000") & " : " & errX.Description
Next
End Select
MsgBox strErrMsg
End Sub |