[Catégorie modifiée .Net - VBA] Connexion à une base MySQL distante et extracti

Question

Bonjour, Je souhaite me connecter à une base de données distante (Cf. la requête SQL dans le cript VBA) pour en exporter le contenu dans une feuille sous Excel 2010. La requête SQL fonctionne parfaitement via le connecteur ODBC. Je souhaite toutefois l'intégrer dans un requête VB afin de pourvoir à terme verrouiller le document en modification et ajouter un bouton pour exécuter le script VB d'import des données. Comme je suis totalement débutant en VB, j'ai repris un code existant (Cf. plus bas). J'obtiens toutefois une erreur à l'exécution et le script bloque sur cette instruction : rs.Open sqlstr, conn, adOpenStatic, adLockReadOnly Avec le message d'erreur : "Ce pilote ODBC ne prend pas en charge les propriétés demandées" A priori donc, la séquence de connexion à la BDD fonctionne, mais les données ne s'actualise pas dans Excel. Il y a à coup sûr plusieurs erreurs ou approximations dans mon code, étant dans une phase découverte du langage. Pour gagner du temps, et parce que je butte, je sollicite votre aide. Merci par avance de votre temps et de vos conseils. Cordialement, Stéphane. Sub sql() Dim conn As New ADODB.Connection Dim server_name As String Dim database_name As String Dim user_id As String Dim password As String Dim sqlstr As String Dim table1 As String Dim rs As ADODB.Recordset Dim vtype As Variant server_name = "XXX.XXX.XXX.XXX" database_name = "DATABASE" user_id = "USER" password = "PASSWORD1" Set conn = New ADODB.Connection conn.Open "DRIVER={Mysqlstr ODBC 5.1 Driver}" _ & ";SERVER=" & server_name _ & ";DATABASE=" & database_name _ & ";UID=" & user_id _ & ";PWD=" & password _ & ";OPTION=16427" vtype = Array("Text", "LongText", "Int(10)", "Float", "Double", "Date", "Time") ' array of commonly used Mysqlstr variable types table1 = "helpdesk" Set rs = New ADODB.Recordset sqlstr = "SELECT Z.*" sqlstr = sqlstr & ", dateTimeDiff(datedebutretenu,dateresolu, 9) as duree" sqlstr = sqlstr & ", dateTimeDiff(datedebutretenu,dateresolu, 1) as dureeho" sqlstr = sqlstr & ", dateTimeDiff(datedebutretenu,dateresolu, 5) as dureeso" sqlstr = sqlstr & ", ifnull(nattcli,0) as nattcli,ifnull(secattcli,0) as secattcli, ifnull(secoattcli,0) as secoattcli, ifnull(secsoattcli,0) as secsoattcli" sqlstr = sqlstr & ", ifnull(nattext,0) as nattext,ifnull(secattext,0) as secattext, ifnull(secoattext,0) as secoattext, ifnull(secsoattext,0) as secsoattext" sqlstr = sqlstr & ", ifnull(ntransit,0) as ntransit,ifnull(sectransit,0) as sectransit, ifnull(secotransit,0) as secotransit, ifnull(secsotransit,0) as secsotransit" sqlstr = sqlstr & "" sqlstr = sqlstr & "FROM (" sqlstr = sqlstr & "SELECT X.*" sqlstr sqlstr & ", CONVERT(IF(requestId 20482" sqlstr = sqlstr & ", IF (DatePrevue < DateCreation, dateresolu, DatePrevue)" sqlstr = sqlstr & ", DateCreation)" sqlstr = sqlstr & ", DATETIME) AS datedebutretenu" sqlstr sqlstr & ", CONVERT(IF(requestId 20482" sqlstr = sqlstr & ",IF (DatePrevue < DateCreation" sqlstr = sqlstr & ", IF(Status REGEXP '^(Clos|R.*solu)$', DateResolv, NOW())" sqlstr = sqlstr & ", IF(Status REGEXP '^(Clos|R.*solu)$' AND DatePrevue > DateResolv, DateResolv, DatePrevue))" sqlstr = sqlstr & ", DateCreation)" sqlstr = sqlstr & ", DATETIME) AS dategroupement" sqlstr = sqlstr & "FROM (" sqlstr = sqlstr & "SELECT t.* , CONVERT(ifnull(d.DateResolvForce,'1970-01-01 00:00:00'), DATETIME) as DateResolvForce" sqlstr = sqlstr & ", CONVERT(IF (Status REGEXP '^(Clos|R.*solu)$'" sqlstr = sqlstr & ", IF(YEAR(IFNULL(DateResolvForce,DateResolvEff)) > 1970" sqlstr = sqlstr & ", IFNULL(DateResolvForce,DateResolvEff)" sqlstr = sqlstr & ", IF (YEAR(DateResolv) > 1970, DateResolv, DateDernInterv))" sqlstr = sqlstr & ", NOW())" sqlstr = sqlstr & ",DATETIME) AS dateresolu" sqlstr = sqlstr & "FROM tickets t " sqlstr sqlstr & "JOIN mgd_Client C ON (C.id t.ClientId) " sqlstr sqlstr & "LEFT JOIN ForceDateResolv d ON (d.TicketId t.TicketId AND d.Systeme = t.Systeme)" sqlstr sqlstr & "where CodeClient 1743" sqlstr = sqlstr & ") X" sqlstr = sqlstr & ") Z" sqlstr sqlstr & "LEFT JOIN ticketsRecapAttente A ON (A.Systeme Z.Systeme AND A.TicketId = Z.TicketId AND ApresResol = 0);" & table1 rs.Open sqlstr, conn, adOpenStatic, adLockReadOnly With données.Cells(1, 60).EntireColumn.Select .ClearContents .CopyFromRecordset rs End With On Error Resume Next rst.Close Set rs = Nothing conn.Close Set conn = Nothing On Error GoTo 0 End Sub

cs_Jack · Answer

Salut

VBA n'est pas du .Net --> Catégorie modifiée

Vérifie l'état de ta connexion après ton
conn.Open
avec quelque chose du genre
    ' Attend connexion terminée
    Do While (conn.State = adStateConnecting)
        DoEvents
    Loop
    ' Test la connexion
    If conn.State <> adStateOpen Then
        MsgBox "Pas de connexion"
        Exit Sub
    EndIf
Es-tu sûr d'avoir besoin de ODBC ?

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

cgandco · Answer

Bonjour,

1 C'est quoi ton message d'erreur?

2 Ton MySQL il connaît pas les procedures stockées ? (c'est plus simple à comprendre et debug)

Bonne soirée



Faites simple, aussi simple que possible, mais pas simpliste.
                                              A. Einstein.

urbandot · Answer

Bonjour,

Merci de vos réponses ; (et du changement de file).

Voici le message d'erreur précis reçu à l'exécution de la macro :

Erreur d'exécution '-214721887 (80040e21)':
Ce pilote ODBC ne prend pas en charge les propriétés demandées.

Le script bloque sur cette instruction :


rs.Open sqlstr, conn, adOpenStatic, adLockReadOnly


J'ai tenté la vérification de la cnx (OK), avec le même message d'erreur ensuite.

Bien cordialement,

Stéphane.

cgandco · Answer

Bonjour,

test avec des parentheses car Open n'est pas une propriété mais une fonction (j'ai pas testé mais ca me semble logique)

pas

rs.Open sqlstr, conn, adOpenStatic, adLockReadOnly


mais

rs.Open (sqlstr, conn, adOpenStatic, adLockReadOnly)

bonne journée



Faites simple, aussi simple que possible, mais pas simpliste.
                                              A. Einstein.

urbandot · Answer

OK ; j'ai réussi à m'en sortir en approfondissant mes connaissances sur le sujet. Voici la requête complètement opérationnelle pour ceu xqui pourrait en avoir besoin : (Il ne me reste "plus qu'à" comprendre comment actualiser les données automatiquement dans la requête VB une fois les données mises à jour dans le classeur "source" (data)). Sub mysql() Dim conn As New ADODB.Connection Set conn = New ADODB.Connection Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset Dim server_name As String Dim database_name As String Dim user_id As String Dim password As String Dim sqlstr As String Dim vtype As Variant Set ws = Worksheets("data") Set cl = Worksheets("SLA") driver_name = "{Mysql ODBC 5.1 Driver}" server_name = "XXX.XXX.XXX.XXX" database_name = "DB" user_id = "USER" password = "PASS" conn.Open "DRIVER=" & driver_name _ & ";SERVER=" & server_name _ & ";DATABASE=" & database_name _ & ";UID=" & user_id _ & ";PWD=" & password _ & ";OPTION=16427" conn.CursorLocation = adUseClient vtype = Array("Text", "LongText", "Int(10)", "Float", "Double", "Date", "Time") sqlstr = "SELECT Z.*" sqlstr = sqlstr & ", dateTimeDiff(datedebutretenu,dateresolu, 9) as duree" sqlstr = sqlstr & ", dateTimeDiff(datedebutretenu,dateresolu, 1) as dureeho" sqlstr = sqlstr & ", dateTimeDiff(datedebutretenu,dateresolu, 5) as dureeso" sqlstr = sqlstr & ", ifnull(nattcli,0) as nattcli,ifnull(secattcli,0) as secattcli, ifnull(secoattcli,0) as secoattcli, ifnull(secsoattcli,0) as secsoattcli" sqlstr = sqlstr & ", ifnull(nattext,0) as nattext,ifnull(secattext,0) as secattext, ifnull(secoattext,0) as secoattext, ifnull(secsoattext,0) as secsoattext" sqlstr = sqlstr & ", ifnull(ntransit,0) as ntransit,ifnull(sectransit,0) as sectransit, ifnull(secotransit,0) as secotransit, ifnull(secsotransit,0) as secsotransit" sqlstr = sqlstr & " FROM (" sqlstr = sqlstr & " SELECT X.*" sqlstr sqlstr & ", CONVERT(IF(requestId 20482" sqlstr = sqlstr & ", IF (DatePrevue < DateCreation, dateresolu, DatePrevue)" sqlstr = sqlstr & ", DateCreation)" sqlstr = sqlstr & ", DATETIME) AS datedebutretenu" sqlstr sqlstr & ", CONVERT(IF(requestId 20482" sqlstr = sqlstr & ",IF (DatePrevue < DateCreation" sqlstr = sqlstr & ", IF(Status REGEXP '^(Clos|R.*solu)$', DateResolv, NOW())" sqlstr = sqlstr & ", IF(Status REGEXP '^(Clos|R.*solu)$' AND DatePrevue > DateResolv, DateResolv, DatePrevue))" sqlstr = sqlstr & ", DateCreation)" sqlstr = sqlstr & ", DATETIME) AS dategroupement" sqlstr = sqlstr & " FROM (" sqlstr = sqlstr & " SELECT t.* , CONVERT(ifnull(d.DateResolvForce,'1970-01-01 00:00:00'), DATETIME) as DateResolvForce" sqlstr = sqlstr & ", CONVERT(IF (Status REGEXP '^(Clos|R.*solu)$'" sqlstr = sqlstr & ", IF(YEAR(IFNULL(DateResolvForce,DateResolvEff)) > 1970" sqlstr = sqlstr & ", IFNULL(DateResolvForce,DateResolvEff)" sqlstr = sqlstr & ", IF (YEAR(DateResolv) > 1970, DateResolv, DateDernInterv))" sqlstr = sqlstr & ", NOW())" sqlstr = sqlstr & ",DATETIME) AS dateresolu" sqlstr = sqlstr & " FROM tickets t " sqlstr sqlstr & "JOIN mgd_Client C ON (C.id t.ClientId) " sqlstr sqlstr & "LEFT JOIN ForceDateResolv d ON (d.TicketId t.TicketId AND d.Systeme = t.Systeme) " sqlstr sqlstr & "where CodeClient " & cl.Cells(7, 11).Value sqlstr = sqlstr & " ) X" sqlstr = sqlstr & " ) Z" sqlstr sqlstr & " LEFT JOIN ticketsRecapAttente A ON (A.Systeme Z.Systeme AND A.TicketId = Z.TicketId AND ApresResol = 0);" rs.Open sqlstr, conn, adOpenStatic, adLockOptimistic With ws.Range("A2:BH65536") .CopyFromRecordset rs End With On Error Resume Next rst.Close Set rs = Nothing conn.Close Set conn = Nothing On Error GoTo 0 End Sub

[Catégorie modifiée .Net -> VBA] Connexion à une base MySQL distante et extracti

5 réponses

Votre réponse

Discussions similaires