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
| OPTION Explicit
Const adStateClosed = 0 'Indique que l'objet Recordset est fermé.
'Const adStateOpen = 1 'Indique que l'objet est ouvert.
Sub ConnBds()
MsgBox "Entrée dans la Sub", vbInformation, "Infos" '**************************************
Dim strConn, objConn, objRstDataBase, MsgDataBase
strConn = "DRIVER={MySQL ODBC 5.3 ANSI Driver}; Server=192.168.xx.xx; User ID=read; Password=read;"
Set objConn = CreateObject("ADODB.Connection")
MsgBox "Tentative connexion de la BDs", vbInformation, "Infos" '**************************************
On Error Resume Next
objConn.open strConn
MsgBox "Tentative connexion de la BDs" & vbNewLine & "FAIT", vbInformation, "Infos" '**************************************
'Erreur ?
If Err.Number <> 0 Then
MsgDataBase = "Erreur N°" & Err.Number & vbCrLf _
& "Description:" & vbCrLf & Err.Description & vbCrLf _
& "Impossible d'ouvrire la BDs "
MsgBox MsgDataBase, vbCritical, "Erreur connexion BDs"
Exit Sub
End if
'strConn est bon mais l'ouverture ne fonctionne pas
If objConn.State = adStateClosed Then
MsgBox "Echec à la connexion de la BDs", vbCritical, "Echec"
Exit Sub
End if
'La connexion à la BDs est OK, passage à l'ouverture de la table
MsgBox "Tentative .Execute (SHOW DATABASES)", vbInformation, "Infos" '**************************************
Set objRstDataBase = objConn.Execute ("SHOW DATABASES")
MsgBox "Tentative .Execute (SHOW DATABASES)" & vbNewLine & "FAIT", vbInformation, "Infos" '**************************************
'Erreur ?
If Err.Number <> 0 Then
MsgDataBase = "Erreur N°" & Err.Number & vbCrLf _
& "Description:" & vbCrLf & Err.Description & vbCrLf _
& "Impossible d'executer la commande SHOW DATABASES"
MsgBox MsgDataBase, vbCritical, "Erreur SHOW DATABASES"
Exit Sub
End if
'strConn est bon mais l'ouverture ne fonctionne pas
If objRstDataBase.State = adStateClosed Then
MsgBox "Echec de la commande SHOW DATABASES", vbCritical, "Echec"
Exit Sub
End if
'ICI, à priori, tout est OK
Dim T
If Not objRstDataBase.EOF Then
MsgDataBase = "Nbr d'enregistrement recupéré: " & objRstDataBase.RecordCount & vbNewLine
For T = 1 To objRstDataBase.RecordCount
MsgDataBase = MsgDataBase & objRstDataBase.Fields(0).Name & " : " & objRstDataBase.Fields(0)
objRstDataBase.MoveNext
If Not objRstDataBase.EOF Then MsgDataBase = MsgDataBase & vbNewLine
Next
Else
MsgDataBase = "Aucun enregistrement retourné"
End If
MsgBox MsgDataBase, vbInformation, "Comme-ci, comme-ça ...."
'nettoyage
Set objRstDataBase = Nothing
Set objConn = Nothing
MsgBox "dernier message fin de la Sub", vbInformation, "Infos" '**************************************
End Sub |
Partager