{"id":171,"date":"2004-07-26T16:55:48","date_gmt":"2004-07-26T14:55:48","guid":{"rendered":"http:\/\/www.marblestation.com\/blog\/?p=171"},"modified":"2012-04-26T19:01:41","modified_gmt":"2012-04-26T17:01:41","slug":"cdigo-vba-para-fusionar-ms-access-con-mysql","status":"publish","type":"post","link":"https:\/\/www.marblestation.com\/?p=171","title":{"rendered":"C\u00f3digo VBA para fusionar MS Access con MySQL"},"content":{"rendered":"<p>El c\u00f3digo que viene a continuaci\u00f3n puede servir de ejemplo para pasar datos de una base de datos MS Access a una MySQL utilizando el driver ODBC de MySQL. La idea seria crear una tercera BD Access con una tabla linkada a la BD Access original y otra tabla linkada con el servidor MySQL usando ODBC. Esto demuestra que es posible realizar una migraci\u00f3n de MS Access a MySQL, la cual podria ir acompa\u00f1ada del fant\u00e1stico front-end <a href=\"http:\/\/www.mysql.com\/products\/mysqlcc\/\">MySQL Control Center<\/a>.<\/p>\n<p>El c\u00f3digo esta escrito en VBA y se debe ejecutar desde MS Access. Hay muchas zonas cortadas ya que son repetitivas, estan se\u00f1aladas con &#8220;[&#8230;]&#8221;:<\/p>\n<p><!--more--><\/p>\n<pre>\r\nOption Compare Database\r\n'Option Explicit\r\n\r\n' ExecuteQuery: Realitza una modificaci\u00f3 a la BD\r\n' Provar amb:\r\n'  ExecuteQuery \"INSERT INTO CamaraEnvasadoPreenvasado VALUES ('test', 'borrar')\"\r\nSub ExecuteQuery(strSQL As String)\r\n   Dim cnn          As ADODB.Connection\r\n   Dim lngAffected  As Long\r\n   \r\n   ' Open the connection.\r\n   Set cnn = CurrentProject.Connection\r\n\r\n   ' Execute the query.\r\n   cnn.Execute CommandText:=strSQL, _\r\n               RecordsAffected:=lngAffected, _\r\n               Options:=adExecuteNoRecords\r\n\r\n   'Debug.Print \"Records Affected = \" & lngAffected\r\n   \r\n   ' Close connection and destroy object variables.\r\n   cnn.Close\r\n   Set cnn = Nothing\r\nEnd Sub\r\n\r\nSub Fusionar()\r\n    Dim cnnDB As ADODB.Connection\r\n    Dim recordSt As New ADODB.Recordset\r\n    Dim recordSt2 As New ADODB.Recordset\r\n    Dim strSQL As String\r\n    Dim idSuscriptor As String\r\n    Dim fecha1 As Date\r\n    Dim fecha2 As Date\r\n    Dim i As Integer\r\n    Dim sql As String\r\n    ' Campos\r\n    Dim TipoRelacion As Variant\r\n    Dim Sector1 As Variant\r\n    Dim Sector2 As Variant\r\n     [...]\r\n\r\n    ' Connectar a la BD actual:\r\n    Set cnnDB = CurrentProject.Connection\r\n\r\n    ' Seleccionamos todas las empresas de la BD local (access)\r\n    strSQL = \"SELECT * FROM Empresa\"\r\n    With recordSt\r\n        Set .ActiveConnection = cnnDB\r\n        .CursorType = adOpenKeyset\r\n        .CursorLocation = adUseClient\r\n        .LockType = adLockOptimistic\r\n        .Open strSQL\r\n    End With\r\n    \r\n    i = 0\r\n    If Not recordSt.EOF Then\r\n        recordSt.MoveFirst\r\n    End If\r\n    ' Por cada empresa...\r\n    Do While Not recordSt.EOF\r\n        idSuscriptor = recordSt.Fields(\"Numero de subscriptor\").Value\r\n        fecha1 = recordSt.Fields(\"Fecha\").Value\r\n        \r\n        ' Buscar el registro equivalente en la BD externa (MySQL)\r\n        strSQL = \"SELECT * FROM empresa1 WHERE NumSuscriptor = \" & idSuscriptor\r\n        With recordSt2\r\n            Set .ActiveConnection = cnnDB\r\n            .CursorType = adOpenKeyset\r\n            .CursorLocation = adUseClient\r\n            .LockType = adLockOptimistic\r\n            .Open strSQL\r\n        End With\r\n        \r\n        If Not recordSt2.EOF Then\r\n        'If 1 = 0 Then\r\n            recordSt2.MoveFirst\r\n            ' El registro existe en ambas BD\r\n            \r\n            fecha2 = recordSt2.Fields(\"FechaActualizacion\").Value\r\n            'Debug.Print DateDiff(\"s\", fecha1, fecha2)\r\n            'Debug.Print DateDiff(\"s\", fecha1, Date)\r\n            'Debug.Print DateDiff(\"s\", Date, fecha2)\r\n            If (DateDiff(\"s\", fecha1, fecha2) > 0) Then\r\n            'If (1 = 1) Then\r\n                ' El registro m\u00e1s actual se encuentra en la BD externa (MySQL)\r\n                \r\n                ' El tratamiento de los campos para actualizar la BD local es diferente\r\n                ' ya que esta definida para que no soporte cadenas de longitud 0 como ''\r\n                TipoRelacion = EscapeForAccess(recordSt2.Fields(\"TipoRelacion\").Value)\r\n                Sector1 = EscapeForAccess(recordSt2.Fields(\"Sector1\").Value)\r\n                Sector2 = EscapeForAccess(recordSt2.Fields(\"Sector2\").Value)\r\n                Sector3 = EscapeForAccess(recordSt2.Fields(\"Sector3\").Value)\r\n                [...]\r\n\r\n                \r\n                If (recordSt2.Fields(\"SuscriptorOnline\").Value = 1) Then\r\n                    SuscriptorOnline = \"True\"\r\n                Else\r\n                    SuscriptorOnline = \"False\"\r\n                End If\r\n                \r\n                If (recordSt2.Fields(\"EColaboradora\").Value = 1) Then\r\n                    EColaboradora = \"True\"\r\n                Else\r\n                    EColaboradora = \"False\"\r\n                End If\r\n                \r\n                'FechaActualizacion = Format(recordSt2.Fields(\"FechaActualizacion\").Value, \"yyyymmddhhnnss\")\r\n                FechaActualizacion = Format(recordSt2.Fields(\"FechaActualizacion\").Value, \"yyyy-mm-dd hh:nn:ss\")\r\n                FechaActualizacion = \"'\" & recordSt2.Fields(\"FechaActualizacion\").Value & \"'\"\r\n                \r\n                MercadoDestino = EscapeForAccess(recordSt2.Fields(\"MercadoDestino\").Value)\r\n                \r\n                If (recordSt2.Fields(\"Visible\").Value = 1) Then\r\n                    Visible = \"True\"\r\n                Else\r\n                    Visible = \"False\"\r\n                End If\r\n                \r\n                'MaxProductes = recordSt2.Fields(\"MaxProductes\").Value\r\n                \r\n                ' Actualizamos BD local (access)\r\n                sql = \"UPDATE Empresa SET Tipo_de_Relacion = \" & TipoRelacion & \", Sector1 = \" & Sector1 & \", Sector2 = \" & Sector2 & \", Sector3 = \" & Sector3 & [...] WHERE [Numero de Subscriptor] = \" & idSuscriptor\r\n\r\n                Debug.Print sql\r\n                'MsgBox sql\r\n                ExecuteQuery sql\r\n            ElseIf (DateDiff(\"s\", fecha1, fecha2) &#60; 0) Then\r\n            'ElseIf (1 = 1) Then\r\n                ' El registro m\u00e1s actual se encuentra en la BD local (access)\r\n                TipoRelacion = EscapeForMySQL(recordSt.Fields(\"Tipo_de_Relacion\").Value)\r\n                Sector1 = EscapeForMySQL(recordSt.Fields(\"Sector1\").Value)\r\n                Sector2 = EscapeForMySQL(recordSt.Fields(\"Sector2\").Value)\r\n                Sector3 = EscapeForMySQL(recordSt.Fields(\"Sector3\").Value)\r\n                [...]\r\n\r\n                If (recordSt.Fields(\"Subscriptor_on_line\").Value) Then\r\n                    SuscriptorOnline = 1\r\n                Else\r\n                    SuscriptorOnline = 0\r\n                End If\r\n                If (recordSt.Fields(\"Empresa_colaborador\").Value) Then\r\n                    EColaboradora = 1\r\n                Else\r\n                    EColaboradora = 0\r\n                End If\r\n                FechaActualizacion = Format(recordSt.Fields(\"Fecha\").Value, \"yyyy-mm-dd hh:nn:ss\")\r\n                MercadoDestino = EscapeForMySQL(recordSt.Fields(\"Mercados_de_destino\").Value)\r\n                Visible = EscapeForMySQL(recordSt.Fields(\"Visible\").Value)\r\n                \r\n                ' Actualizamos BD externa (MySQL)\r\n                sql = \"UPDATE empresa1 SET TipoRelacion = '\" & TipoRelacion & \"', Sector1 = '\" & Sector1 & \"', Sector2 = '\" & Sector2 & \"', Sector3 = '\" & Sector3 & [...] \"' WHERE NumSuscriptor = \" & idSuscriptor\r\n                Debug.Print sql\r\n                'MsgBox sql\r\n                ExecuteQuery sql\r\n            Else\r\n                Debug.Print \"Sin cambios (NumSuscriptor \" & idSuscriptor & \")\"\r\n            End If\r\n        Else\r\n            ' Si no existe el registro en la BD externa (MySQL), se trata\r\n            ' de uno nuevo y por tanto se ha de realizar la insercci\u00f3n\r\n            NumSuscriptor = EscapeForMySQL(recordSt.Fields(\"Numero de Subscriptor\").Value)\r\n            TipoRelacion = EscapeForMySQL(recordSt.Fields(\"Tipo_de_Relacion\").Value)\r\n            Sector1 = EscapeForMySQL(recordSt.Fields(\"Sector1\").Value)\r\n            Sector2 = EscapeForMySQL(recordSt.Fields(\"Sector2\").Value)\r\n            Sector3 = EscapeForMySQL(recordSt.Fields(\"Sector3\").Value)\r\n            [...]\r\n            If (IsNull(Provincia) Or (Provincia = \"\")) Then\r\n                Provincia = 0\r\n            Else\r\n                Provincia = recordSt.Fields(\"Provincia\").Value\r\n            End If\r\n            [...]\r\n\r\n            FechaActualizacion = Format(recordSt.Fields(\"Fecha\").Value, \"yyyy-mm-dd hh:nn:ss\")\r\n            MercadoDestino = EscapeForMySQL(recordSt.Fields(\"Mercados_de_destino\").Value)\r\n            'Visible = EscapeForMySQL(recordSt.Fields(\"Visible\").Value)\r\n            If (recordSt.Fields(\"Visible\").Value = 1) Then\r\n                Visible = 1\r\n            Else\r\n                Visible = 0\r\n            End If\r\n                        \r\n            sql = \"INSERT INTO empresa1 (NumSuscriptor, TipoRelacion, Sector1, Sector2, Sector3, [...]) \"\r\n            sql = sql & \" VALUES ('\" & NumSuscriptor & \"', '\" & TipoRelacion & \"', '\" & Sector1 & \"', '\" & Sector2 & \"', '\" & Sector3 & \"', '\" &[...]& \"')\"\r\n            Debug.Print sql\r\n            'MsgBox sql\r\n            ExecuteQuery sql\r\n            \r\n            ' Para poder especificar el valor del timestamp debo hacerlo:\r\n            ' (no puedo hacerlo en el insert, parece un bug de access o del ODBC 2.50)\r\n            \r\n            ' Esto no funciona:\r\n            ' (un bug de access o del ODBC 2.50 ?)\r\n            'sql = \"UPDATE empresa1 SET FechaActualizacion = '\" & FechaActualizacion & \"' WHERE NumSuscriptor = \" & NumSuscriptor\r\n            'Debug.Print sql\r\n            'ExecuteQuery sql\r\n            \r\n            ' Funciona:\r\n            sql = \"UPDATE empresa1 SET TipoRelacion = '\" & TipoRelacion & \"', Sector1 = '\" & Sector1 & \"', Sector2 = '\" & Sector2 & \"', Sector3 = '\" & Sector3 & [...] & \"' WHERE NumSuscriptor = \" & idSuscriptor\r\n            Debug.Print \"Actualizar timestamp del ultimo insert:\"\r\n            Debug.Print sql\r\n            'MsgBox sql\r\n            ExecuteQuery sql\r\n            \r\n        End If\r\n        \r\n        recordSt2.Close\r\n        recordSt.MoveNext\r\n    Loop\r\n    \r\n   Debug.Print \"End\"\r\n   \r\n   ' Close Connection object and destroy object variable.\r\n   cnnDB.Close\r\n   Set cnnDB = Nothing\r\nEnd Sub\r\n\r\nPublic Function Escape(ByVal strString As String) As String\r\n' ************* Declare our Regex Array ****************\r\nDim FindTerm(1)\r\nFindTerm(0) = \"'\"\r\n'FindTerm(1) = \"\"\"\"\r\n\r\n' *************************************************\r\nFor i = 0 To 0\r\n    ' Purpose:      To replace all occurrences of one string in another\r\n    Dim intPos As Integer, intLP As Integer, intLen As Integer, strTemp As String\r\n    ' find each search string and replace with target\r\n    intLen = Len(FindTerm(i))\r\n    intPos = InStr(strString, FindTerm(i))\r\n    While intPos &#60;> 0\r\n        strTemp = strTemp & left$(strString, intPos - 1)\r\n        'strTemp = strTemp & \"\" & FindTerm(i)\r\n        strTemp = strTemp & FindTerm(i) & FindTerm(i)\r\n        strString = right$(strString, Len(strString) - intPos - intLen + 1)\r\n        intPos = InStr(strString, FindTerm(i))\r\n    Wend\r\n    ' append remainder upon failure of last InStr search\r\nNext\r\nstrTemp = strTemp & strString\r\nEscape = strTemp\r\nEnd Function\r\n\r\nPublic Function EscapeForAccess(strString) As Variant\r\n    If IsNull(strString) Then\r\n        EscapeForAccess = \"null\"\r\n    Else\r\n        EscapeForAccess = \"'\" & Escape(strString) & \"'\"\r\n    End If\r\nEnd Function\r\n\r\nPublic Function EscapeForMySQL(strString) As Variant\r\n    If IsNull(strString) Then\r\n        EscapeForMySQL = Null\r\n    Else\r\n        EscapeForMySQL = Escape(strString)\r\n    End If\r\nEnd Function\r\n<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>El c\u00f3digo que viene a continuaci\u00f3n puede servir de ejemplo para pasar datos de una base de datos MS Access a una MySQL utilizando el driver ODBC de MySQL. La idea seria crear una tercera BD Access con una tabla linkada a la BD Access original y otra tabla linkada con el servidor MySQL usando &hellip; <a href=\"https:\/\/www.marblestation.com\/?p=171\" class=\"more-link\">Continue reading <span class=\"screen-reader-text\">C\u00f3digo VBA para fusionar MS Access con MySQL<\/span> <span class=\"meta-nav\">&rarr;<\/span><\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[1,6],"tags":[],"class_list":["post-171","post","type-post","status-publish","format-standard","hentry","category-espanyol","category-tecnologia"],"_links":{"self":[{"href":"https:\/\/www.marblestation.com\/index.php?rest_route=\/wp\/v2\/posts\/171","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.marblestation.com\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.marblestation.com\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.marblestation.com\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.marblestation.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=171"}],"version-history":[{"count":1,"href":"https:\/\/www.marblestation.com\/index.php?rest_route=\/wp\/v2\/posts\/171\/revisions"}],"predecessor-version":[{"id":1751,"href":"https:\/\/www.marblestation.com\/index.php?rest_route=\/wp\/v2\/posts\/171\/revisions\/1751"}],"wp:attachment":[{"href":"https:\/\/www.marblestation.com\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=171"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.marblestation.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=171"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.marblestation.com\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=171"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}