El código que viene a continuación 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ón de MS Access a MySQL, la cual podria ir acompañada del fantástico front-end MySQL Control Center.
El código esta escrito en VBA y se debe ejecutar desde MS Access. Hay muchas zonas cortadas ya que son repetitivas, estan señaladas con “[…]”:
Option Compare Database 'Option Explicit ' ExecuteQuery: Realitza una modificació a la BD ' Provar amb: ' ExecuteQuery "INSERT INTO CamaraEnvasadoPreenvasado VALUES ('test', 'borrar')" Sub ExecuteQuery(strSQL As String) Dim cnn As ADODB.Connection Dim lngAffected As Long ' Open the connection. Set cnn = CurrentProject.Connection ' Execute the query. cnn.Execute CommandText:=strSQL, _ RecordsAffected:=lngAffected, _ Options:=adExecuteNoRecords 'Debug.Print "Records Affected = " & lngAffected ' Close connection and destroy object variables. cnn.Close Set cnn = Nothing End Sub Sub Fusionar() Dim cnnDB As ADODB.Connection Dim recordSt As New ADODB.Recordset Dim recordSt2 As New ADODB.Recordset Dim strSQL As String Dim idSuscriptor As String Dim fecha1 As Date Dim fecha2 As Date Dim i As Integer Dim sql As String ' Campos Dim TipoRelacion As Variant Dim Sector1 As Variant Dim Sector2 As Variant [...] ' Connectar a la BD actual: Set cnnDB = CurrentProject.Connection ' Seleccionamos todas las empresas de la BD local (access) strSQL = "SELECT * FROM Empresa" With recordSt Set .ActiveConnection = cnnDB .CursorType = adOpenKeyset .CursorLocation = adUseClient .LockType = adLockOptimistic .Open strSQL End With i = 0 If Not recordSt.EOF Then recordSt.MoveFirst End If ' Por cada empresa... Do While Not recordSt.EOF idSuscriptor = recordSt.Fields("Numero de subscriptor").Value fecha1 = recordSt.Fields("Fecha").Value ' Buscar el registro equivalente en la BD externa (MySQL) strSQL = "SELECT * FROM empresa1 WHERE NumSuscriptor = " & idSuscriptor With recordSt2 Set .ActiveConnection = cnnDB .CursorType = adOpenKeyset .CursorLocation = adUseClient .LockType = adLockOptimistic .Open strSQL End With If Not recordSt2.EOF Then 'If 1 = 0 Then recordSt2.MoveFirst ' El registro existe en ambas BD fecha2 = recordSt2.Fields("FechaActualizacion").Value 'Debug.Print DateDiff("s", fecha1, fecha2) 'Debug.Print DateDiff("s", fecha1, Date) 'Debug.Print DateDiff("s", Date, fecha2) If (DateDiff("s", fecha1, fecha2) > 0) Then 'If (1 = 1) Then ' El registro más actual se encuentra en la BD externa (MySQL) ' El tratamiento de los campos para actualizar la BD local es diferente ' ya que esta definida para que no soporte cadenas de longitud 0 como '' TipoRelacion = EscapeForAccess(recordSt2.Fields("TipoRelacion").Value) Sector1 = EscapeForAccess(recordSt2.Fields("Sector1").Value) Sector2 = EscapeForAccess(recordSt2.Fields("Sector2").Value) Sector3 = EscapeForAccess(recordSt2.Fields("Sector3").Value) [...] If (recordSt2.Fields("SuscriptorOnline").Value = 1) Then SuscriptorOnline = "True" Else SuscriptorOnline = "False" End If If (recordSt2.Fields("EColaboradora").Value = 1) Then EColaboradora = "True" Else EColaboradora = "False" End If 'FechaActualizacion = Format(recordSt2.Fields("FechaActualizacion").Value, "yyyymmddhhnnss") FechaActualizacion = Format(recordSt2.Fields("FechaActualizacion").Value, "yyyy-mm-dd hh:nn:ss") FechaActualizacion = "'" & recordSt2.Fields("FechaActualizacion").Value & "'" MercadoDestino = EscapeForAccess(recordSt2.Fields("MercadoDestino").Value) If (recordSt2.Fields("Visible").Value = 1) Then Visible = "True" Else Visible = "False" End If 'MaxProductes = recordSt2.Fields("MaxProductes").Value ' Actualizamos BD local (access) sql = "UPDATE Empresa SET Tipo_de_Relacion = " & TipoRelacion & ", Sector1 = " & Sector1 & ", Sector2 = " & Sector2 & ", Sector3 = " & Sector3 & [...] WHERE [Numero de Subscriptor] = " & idSuscriptor Debug.Print sql 'MsgBox sql ExecuteQuery sql ElseIf (DateDiff("s", fecha1, fecha2) < 0) Then 'ElseIf (1 = 1) Then ' El registro más actual se encuentra en la BD local (access) TipoRelacion = EscapeForMySQL(recordSt.Fields("Tipo_de_Relacion").Value) Sector1 = EscapeForMySQL(recordSt.Fields("Sector1").Value) Sector2 = EscapeForMySQL(recordSt.Fields("Sector2").Value) Sector3 = EscapeForMySQL(recordSt.Fields("Sector3").Value) [...] If (recordSt.Fields("Subscriptor_on_line").Value) Then SuscriptorOnline = 1 Else SuscriptorOnline = 0 End If If (recordSt.Fields("Empresa_colaborador").Value) Then EColaboradora = 1 Else EColaboradora = 0 End If FechaActualizacion = Format(recordSt.Fields("Fecha").Value, "yyyy-mm-dd hh:nn:ss") MercadoDestino = EscapeForMySQL(recordSt.Fields("Mercados_de_destino").Value) Visible = EscapeForMySQL(recordSt.Fields("Visible").Value) ' Actualizamos BD externa (MySQL) sql = "UPDATE empresa1 SET TipoRelacion = '" & TipoRelacion & "', Sector1 = '" & Sector1 & "', Sector2 = '" & Sector2 & "', Sector3 = '" & Sector3 & [...] "' WHERE NumSuscriptor = " & idSuscriptor Debug.Print sql 'MsgBox sql ExecuteQuery sql Else Debug.Print "Sin cambios (NumSuscriptor " & idSuscriptor & ")" End If Else ' Si no existe el registro en la BD externa (MySQL), se trata ' de uno nuevo y por tanto se ha de realizar la insercción NumSuscriptor = EscapeForMySQL(recordSt.Fields("Numero de Subscriptor").Value) TipoRelacion = EscapeForMySQL(recordSt.Fields("Tipo_de_Relacion").Value) Sector1 = EscapeForMySQL(recordSt.Fields("Sector1").Value) Sector2 = EscapeForMySQL(recordSt.Fields("Sector2").Value) Sector3 = EscapeForMySQL(recordSt.Fields("Sector3").Value) [...] If (IsNull(Provincia) Or (Provincia = "")) Then Provincia = 0 Else Provincia = recordSt.Fields("Provincia").Value End If [...] FechaActualizacion = Format(recordSt.Fields("Fecha").Value, "yyyy-mm-dd hh:nn:ss") MercadoDestino = EscapeForMySQL(recordSt.Fields("Mercados_de_destino").Value) 'Visible = EscapeForMySQL(recordSt.Fields("Visible").Value) If (recordSt.Fields("Visible").Value = 1) Then Visible = 1 Else Visible = 0 End If sql = "INSERT INTO empresa1 (NumSuscriptor, TipoRelacion, Sector1, Sector2, Sector3, [...]) " sql = sql & " VALUES ('" & NumSuscriptor & "', '" & TipoRelacion & "', '" & Sector1 & "', '" & Sector2 & "', '" & Sector3 & "', '" &[...]& "')" Debug.Print sql 'MsgBox sql ExecuteQuery sql ' Para poder especificar el valor del timestamp debo hacerlo: ' (no puedo hacerlo en el insert, parece un bug de access o del ODBC 2.50) ' Esto no funciona: ' (un bug de access o del ODBC 2.50 ?) 'sql = "UPDATE empresa1 SET FechaActualizacion = '" & FechaActualizacion & "' WHERE NumSuscriptor = " & NumSuscriptor 'Debug.Print sql 'ExecuteQuery sql ' Funciona: sql = "UPDATE empresa1 SET TipoRelacion = '" & TipoRelacion & "', Sector1 = '" & Sector1 & "', Sector2 = '" & Sector2 & "', Sector3 = '" & Sector3 & [...] & "' WHERE NumSuscriptor = " & idSuscriptor Debug.Print "Actualizar timestamp del ultimo insert:" Debug.Print sql 'MsgBox sql ExecuteQuery sql End If recordSt2.Close recordSt.MoveNext Loop Debug.Print "End" ' Close Connection object and destroy object variable. cnnDB.Close Set cnnDB = Nothing End Sub Public Function Escape(ByVal strString As String) As String ' ************* Declare our Regex Array **************** Dim FindTerm(1) FindTerm(0) = "'" 'FindTerm(1) = """" ' ************************************************* For i = 0 To 0 ' Purpose: To replace all occurrences of one string in another Dim intPos As Integer, intLP As Integer, intLen As Integer, strTemp As String ' find each search string and replace with target intLen = Len(FindTerm(i)) intPos = InStr(strString, FindTerm(i)) While intPos <> 0 strTemp = strTemp & left$(strString, intPos - 1) 'strTemp = strTemp & "" & FindTerm(i) strTemp = strTemp & FindTerm(i) & FindTerm(i) strString = right$(strString, Len(strString) - intPos - intLen + 1) intPos = InStr(strString, FindTerm(i)) Wend ' append remainder upon failure of last InStr search Next strTemp = strTemp & strString Escape = strTemp End Function Public Function EscapeForAccess(strString) As Variant If IsNull(strString) Then EscapeForAccess = "null" Else EscapeForAccess = "'" & Escape(strString) & "'" End If End Function Public Function EscapeForMySQL(strString) As Variant If IsNull(strString) Then EscapeForMySQL = Null Else EscapeForMySQL = Escape(strString) End If End Function