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