Comparar tablas Excel (versión mejorada)

Versión mejorada de la herramienta para comparar tablas Excel mediante Access, que se describe detalladamente en

Comparar tablas excel (con access) – Abraza la Web

En esta bnueva versión se ha mejorado algo el código y añadido funcionalidades nuevas.

• La librería/biblioteca de Excel para VBA se carga ahora de modo «late binding» para evitar errores en las referencias.
• Se añade un contador de progreso para ver por dónde van los cálculos
• Se añade un nuevo campo en la tabla excel de resultados con los valores que se han quitado (OUT) y añadido (IN) al comparar la tabla derecha con la izquierda, aunque no se muestran valores duplicados, sirve para ver fácilmente los cambios (se puede seleccionar esta funcionalidad con un checkbox). Cuando dos campos son iguales en las tablas, este nuevo campo IN/OUT se muestra vacío evidentemen

La tabla Excel resultado es ahora así, mostrando claramente qué es lo que cambia

El enlace para descarga:

El código fuente de la aplicación (formulario). Se incluyen comentarios y parte de las distintas pruebas realizadas para optimización (comentadas)

Option Compare Database
Const camposCombo1 = "campo1_1,campo1_2,campo1_3,campo1_4,campo1_5,campo1_6,campo1_7" ' para usar en arrays en el código y permitir escalabilidad
Const camposCombo2 = "campo2_1,campo2_2,campo2_3,campo2_4,campo2_5,campo2_6,campo2_7" ' para usar en arrays en el código



Private Sub actualizarTablas_Click()
Call Form_Load
End Sub



Private Sub comandoEjecutar_Click()

' late binding the Excel object  por errores en algunos PCs

Dim xlApp As Object 'Excel.Application
Dim xlWB As Object 'Excel.Workbook
Dim xlSh As Object 'Excel.Worksheet
Dim row As Integer
Dim col As Integer
Dim count As Integer

Dim db As DAO.Database
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset

Dim seleccion As String
Dim total As String
Dim campo1 As String
Dim campo2 As String

Dim campos1(20) As String
Dim campos2(20) As String

Dim valor As Variant
Dim i As Integer
Dim j As Integer

Dim strQuery As String

On Error GoTo ERROR


'inicializar
DoCmd.Hourglass True

' comprobar que el campo a comprobar está seleccionado en ambas tablas
If comboCampo1 = "" Or comboCampo2 = "" Then
        MsgBox ("Alguno de los campos comunes no se ha seleccionado")
        Exit Sub
End If

' limpiar las tablas para que no haya nulos
quitarNulos (comboTablas1)
quitarNulos (comboTablas2)

For i = 0 To UBound(campos1) - LBound(campos1) - 1
    campos1(i) = ""
    campos2(i) = ""
Next
count = 1
row = 1
col = 1

Set db = CurrentDb()

'------------------------------------------
' Búsqueda de duplicados en ambas tablas
'------------------------------------------

' Para las primeras consultas
campo1 = "[" & comboTablas1 & "].[" & comboCampo1 & "]"
campo2 = "[" & comboTablas2 & "].[" & comboCampo2 & "]"

strQuery = "SELECT " & campo1 & ",* FROM [" & comboTablas1 & "] " _
    & "WHERE (((" & campo1 & ") In (SELECT [" & comboCampo1 & "] " _
    & "FROM [" & comboTablas1 & "] As Tmp GROUP BY [" & comboCampo1 & "] HAVING Count(*)>1 ))) " _
    & "ORDER BY " & campo1 & ";"
'abrir consulta
Set rst1 = db.OpenRecordset(strQuery)

strQuery = "SELECT " & campo2 & ",* FROM [" & comboTablas2 & "] " _
    & "WHERE (((" & campo2 & ") In (SELECT [" & comboCampo2 & "] " _
    & "FROM [" & comboTablas2 & "] As Tmp GROUP BY [" & comboCampo2 & "] HAVING Count(*)>1 ))) " _
    & "ORDER BY " & campo2 & ";"
'abrir consulta
Set rst2 = db.OpenRecordset(strQuery)


' abrir excel de resultados
'Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application") ' late binding
Set xlWB = xlApp.Workbooks.Add ' crea un nuevo libro
Set xlSh = xlWB.Sheets(1) '

'xlApp.Visible = True
xlApp.Visible = False
textLog.SetFocus
Beep
textLog.SetFocus
textLog.Text = "Buscando duplicados..."
DoEvents

' Duplicados tabla 1

xlWB.Sheets(1).Name = Left("Duplicados " & comboTablas1, 30) ' error en tabs con monbres más largos

Call rellenarExcelRst(xlSh, rst1)
'Call rellenarExcel(xlSh, rst1, row, comboCampo1, comboTablas1)

' Duplicados tabla 2
xlWB.Sheets.Add After:=xlWB.Sheets(1)
Set xlSh = xlWB.Sheets(2) '
xlWB.Sheets(2).Name = Left("Duplicados " & comboTablas2, 30)

'Call rellenarExcel(xlSh, rst2, row, comboCampo2, comboTablas2)
Call rellenarExcelRst(xlSh, rst2)

rst1.Close
rst2.Close

'------------------------------------------
' NO COINCIDENTES
'------------------------------------------
textLog.SetFocus
textLog.Text = "Buscando No Coincidentes..."
DoEvents

strQuery = "SELECT * FROM [" & comboTablas1 & "] LEFT JOIN [" & comboTablas2 & "] ON " _
        & campo1 & " = " & campo2 & " WHERE (((" & campo2 & ") Is Null));"


'abrir consulta
Set rst1 = db.OpenRecordset(strQuery)

strQuery = "SELECT * FROM [" & comboTablas2 & "] LEFT JOIN [" & comboTablas1 & "] ON " _
        & campo2 & " = " & campo1 & " WHERE (((" & campo1 & ") Is Null));"

' abrir consulta
Set rst2 = db.OpenRecordset(strQuery)

' Tabla1 no en Tabla2
xlWB.Sheets.Add After:=xlWB.Sheets(2)

Set xlSh = xlWB.Sheets(3) '
xlWB.Sheets(3).Name = Left(comboTablas1 & " FALTAN EN " & comboTablas2, 30)

'row = 1
'Call rellenarExcel(xlSh, rst1, row, comboCampo1, comboTablas1)
Call rellenarExcelRst(xlSh, rst1)

' inmovilizar fila superior
With xlApp.ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
            .FreezePanes = True
End With
    
' Tabla 2 no en Tabla1
xlWB.Sheets.Add After:=xlWB.Sheets(3)

Set xlSh = xlWB.Sheets(4) '
xlWB.Sheets(4).Name = Left(comboTablas2 & " FALTAN EN " & comboTablas1, 30)

'row = 1
'Call rellenarExcel(xlSh, rst2, row, comboCampo2, comboTablas2)
Call rellenarExcelRst(xlSh, rst2)

' inmovilizar fila superior
With xlApp.ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
            .FreezePanes = True
End With
rst1.Close
rst2.Close

'------------------------------------------
' Diffs Tabla 1 vs Tabla2
'------------------------------------------
textLog.SetFocus
textLog.Text = "Buscando Diferencias en los campos..."
DoEvents
' rellenar array campos1
i = 0
For Each valor In Split(camposCombo1, ",")
        If Not IsNull(Me.Controls(valor)) Then
            campos1(i) = Me.Controls(valor)
        Else
            campos1(i) = ""
        End If
        i = i + 1
Next
' rellenar array campos2
i = 0
For Each valor In Split(camposCombo2, ",")
        If Not IsNull(Me.Controls(valor)) Then
            campos2(i) = Me.Controls(valor)
        Else
            campos2(i) = ""
        End If
        i = i + 1
Next

' chequeos de campos y creación consulta
seleccion = ""
total = ""

i = 0

Do While campos1(i) <> ""
    If campos2(i) = "" Then
        MsgBox ("Campo Tabla 2 vacío")
        Exit Sub
    Else
        campo1 = "[" & comboTablas1 & "].[" & campos1(i) & "]"
        campo2 = "[" & comboTablas2 & "].[" & campos2(i) & "]"
        If checkBoxLimpiar.Value = True Then
            seleccion = seleccion & "," & campo1 & "," & campo2 & ", Similitud_adpt(limpiar(" & campo1 & "),limpiar(" & campo2 & ")) AS Expr" & i + 1
        Else
            seleccion = seleccion & "," & campo1 & "," & campo2 & ", Similitud_adpt(" & campo1 & "," & campo2 & ") AS Expr" & i + 1
        End If
        
        If checkBoxInOut.Value = True Then
            seleccion = seleccion & " , inoutDiff(" & campo1 & "," & campo2 & ") AS ExprInOut" & i + 1
        End If
        
        
        If i = 0 Then
            total = ", [Expr" & i + 1 & "]"
        Else
            total = total & "+[Expr" & i + 1 & "]"
        End If
    End If
    
    i = i + 1
Loop

' añadimos la expresión con el valor total de las similitudes
If total <> "" Then total = total & " AS ExprTotal"

' resto de campòs de las tablas
If CheckboxTabla1.Value = True Then
    total = total & ", [" & comboTablas1 & "].*"
End If

If CheckboxTabla2.Value = True Then
    total = total & ", [" & comboTablas2 & "].*"
End If

campo1 = "[" & comboTablas1 & "].[" & comboCampo1 & "]"
campo2 = "[" & comboTablas2 & "].[" & comboCampo2 & "]"

' seleccion y total ya llevan la primera ","
strQuery = "SELECT " & campo1 & seleccion & total & " FROM [" & comboTablas1 & "] INNER JOIN " _
            & "[" & comboTablas2 & "] ON " & campo1 & " = " & campo2 & ";"
' No limpio los campos de la inner join, pues tarda demasiado, hacer esto previamente
'If checkBoxLimpiar.Value = True Then
'    strquery = "SELECT " & campo1 & seleccion & total & " FROM [" & comboTablas1 & "] INNER JOIN " _
'            & "[" & comboTablas2 & "] ON limpiar(" & campo1 & ") = limpiar(" & campo2 & ");"
'End If
' abrir consulta
Set rst1 = db.OpenRecordset(strQuery)


' tratar de vcrear consulta de creación de tabla
' falla con error en "campos solo se pueden crear unan vez es por el incluir el * al final"
' cuando seleccionamos el resto de campos, pero también tarda lo mismo que de las otras maneras
'Dim strOut As String
'strOut = Replace(strQuery, "FROM", " INTO [Diffs] FROM")
'CurrentDb.Execute strOut

' Diffs Tabla1 vs Tabla2
xlWB.Sheets.Add After:=xlWB.Sheets(4)

Set xlSh = xlWB.Sheets(5) '
xlWB.Sheets(5).Name = Left("DIFFS " & comboTablas1 & " vs " & comboTablas2, 30)

row = 1
xlApp.Calculation = xlManual

' Probamos otra manera
' el tiempo se va en crear la tabla (copiarla desde la consulta) pues tarda muchísimo en ello
' VERIFICADO: el tiempo es idéntico de cualquier manera
' copyfromrecorset = crear tabla opción 1 (Insert INTO) = crear tabla opción 2 (bucles anidados y copiar rst)

Call guardarConsulta(strQuery, rst1) ' creamos una tabla y consulta temporales adicionales

' Volcamos a Excel el nuevo rst de la tabla creada, que ya no tiene que
' calcular las fórmulas y es inmediato

Set rst1 = db.OpenRecordset("SELECT * FROM Diffs;")
'Call rellenarExcel(xlSh, rst1, row, comboCampo1, comboTablas1) ' rellena excel registro a registro
Call rellenarExcelRst(xlSh, rst1) ' rellena excel con copyFromRecordset


xlApp.Calculation = xlAutomatic
' inmovilizar fila superior
With xlApp.ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
            .FreezePanes = True
End With
Beep
textLog.Text = "Coloreando tabla Excel..."
DoEvents

Call pintarExcel(xlSh, rst1)

rst1.Close
db.Close
Set rst1 = Nothing
Set rst2 = Nothing
Set db = Nothing

Beep
textLog.SetFocus
textLog.Text = ""
DoEvents
DoCmd.Hourglass False

' eliminamos la tabla temporal
DoCmd.SetWarnings (WarningsOff)
If IsNull(DLookup("name", "msysobjects", "name='Diffs'")) Then
    ' nada
Else
    CurrentDb.TableDefs.Delete "Diffs"
End If
DoCmd.SetWarnings True

MsgBox ("FIN")

xlApp.Visible = True
Exit Sub
ERROR:
    MsgBox ("Ha ocurrido un error" & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf & "Se recargará el formulario")
    DoCmd.Hourglass False
    xlWB.Close
    Call Form_Load
    Exit Sub
End Sub
Private Sub guardarConsulta(strQuery As String, rst As DAO.Recordset)
' https://stackoverflow.com/questions/12608646/in-vba-how-does-one-make-a-table-from-a-recordset
On Error GoTo ERROR

DoCmd.SetWarnings (WarningsOff)

' para la opción 2 no necesito la consulta
'If IsNull(DLookup("name", "msysobjects", "name='Comparación'")) Then
'    CurrentDb.CreateQueryDef "Comparación", strQuery
'Else
'    CurrentDb.QueryDefs("Comparación").SQL = strQuery
'End If

' importar en access como tabla
If IsNull(DLookup("name", "msysobjects", "name='Diffs'")) Then
    ' nada
Else
    CurrentDb.TableDefs.Delete "Diffs"
End If



' crear tabla Diffs
'-------------------------------------------------------------------
Dim tmpTabla As TableDef
Dim i As Integer
Dim fld As Field
Dim newFld As Field
Dim idx As Index

Set tmpTabla = CurrentDb.CreateTableDef("Diffs")

tmpTabla.Name = "Diffs"

' crear campos, primero el Id

Set fld = tmpTabla.CreateField("IDN", dbLong)
fld.Attributes = fld.Attributes + dbAutoIncrField
fld.OrdinalPosition = 1
tmpTabla.Fields.Append fld

' ahora copiamos los de la consulta, reemplazar el "." pq si no da error
For Each fld In rst.Fields
    Set newFld = tmpTabla.CreateField(Replace(fld.Name, ".", "_"), fld.Type, fld.Size)
    If fld.Type = dbText Then newFld.AllowZeroLength = True     ' para permitir valores vacíos y nulos y no tener errores
    tmpTabla.Fields.Append newFld
    'tmpTabla.Fields.Append tmpTabla.CreateField(Replace(fld.Name, ".", "_"), fld.Type, fld.Size)
Next

'clave primaria
tmpTabla.Fields.Refresh
Set idx = tmpTabla.CreateIndex("PrimaryKey")
Set fld = idx.CreateField("IDN", dbLong)
idx.Fields.Append fld
idx.Primary = True
tmpTabla.Indexes.Append idx

CurrentDb.TableDefs.Append tmpTabla
CurrentDb.TableDefs.Refresh

' llenar tabla con los valores de la consulta
'strQuery = "SELECT * INTO Diffs FROM Comparación;"
'DoCmd.RunSQL (strQuery)
' falla con error

' bucle en los campos
Dim j As Integer
Dim ntot As Integer
i = 0
Dim rstDiff As DAO.Recordset
Set rstDiff = CurrentDb.OpenRecordset("Diffs")

'
' NOTA: Los test de tiempo indican que se tarda exactamente lo mismo, y parece mejor mostrar el avance en el form
' por seo deja la segunda opción
'

'--------------------------------------
' opción 1 crear consultas de inserción
'--------------------------------------
' el hacer currentdb.execute "INSERT INTO tabla ( fields,...) VALUES ( values ..) en un bucle"
' falla por desboramiento del strign values al concatenar los valores


' con la consulta de inserción de golpe no hay problemas
'Dim fldFrom As String
'Dim fldTo As String
'fldTo = ""
'For j = 1 To rstDiff.Fields.count - 1 '!!! Ojo saltamos el primer campo que es el autonumérico IDN
'    fldTo = fldTo & "[" & rstDiff.Fields(j).Name & "],"
'Next
'fldTo = Left(fldTo, Len(fldTo) - 1) ' quitar "," final

'fldFrom = ""
'For j = 0 To rst.Fields.count - 1
'    fldFrom = fldFrom & "Comparación.[" & rst.Fields(j).Name & "],"
'Next
'fldFrom = Left(fldFrom, Len(fldFrom) - 1) ' quitar "," final

'Set db = CurrentDb

'Add the records, being sure to use our db object, not CurrentDb
'db.Execute "INSERT INTO Diffs (" & fldTo & ")" & " SELECT  " & fldFrom & " FROM Comparación", dbFailOnError

'-------------------------------------
' OPción copiar uno a uno campo-valor
'------------------------------------
With rst
    If Not (rst.EOF And rst.BOF) Then
        rst.MoveLast
        rst.MoveFirst 'Unnecessary in this case, but still a good habit
        ntot = rst.RecordCount
        Do Until rst.EOF = True
            rstDiff.AddNew
            ' no hace falta gestión de nulos, ya que están pèrmitidos en la definición de la tabla Diffs
            ' además una asignación if null then valor ="" da error si el campo es de tipo numérico
            For j = 0 To rst.Fields.count - 1 ' la tabla tiene 1 campo más, el Id
                rstDiff.Fields(j + 1).Value = rst.Fields(j).Value
            Next
            rstDiff.Update
            rst.MoveNext
            i = i + 1
            If i Mod 50 = 0 Then
                textLog.SetFocus
                textLog.Text = "Procesando " & i & "/" & ntot
                DoEvents
            End If
        Loop
    End If
End With

rst.Close
rstDiff.Close
Set rst = Nothing
Set rstDiff = Nothing


DoCmd.SetWarnings True

'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Comparación", CurrentProject.Path & "\comparar.xls"
Exit Sub
ERROR:
    MsgBox ("Ha ocurrido un error en la geeración de la tabla en access" & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf)
    DoCmd.Hourglass False
    Exit Sub
End Sub


Private Sub rellenarExcelRst(xlSh As Object, rst As DAO.Recordset) 'late binding
'Private Sub rellenarExcelRst(xlSh As Excel.Worksheet, rst As DAO.Recordset)
Dim iCols As Integer
For iCols = 0 To rst.Fields.count - 1
 xlSh.Cells(1, iCols + 1).Value = rst.Fields(iCols).Name
 xlSh.Cells(1, iCols + 1).Interior.ColorIndex = 15
Next
' si el rst está vacío salimos, pues da errores
If rst.EOF Then
    xlSh.Cells(2, 1) = "NO SE HAN ENCONTRADO"
    Exit Sub
End If
rst.MoveLast
rst.MoveFirst

xlSh.Range("A2").CopyFromRecordset rst

'For iCols = 1 To rst.RecordCount
'    xlSh.Rows(iCols).RowHeight = xlSh.Rows(1).RowHeight
'Next
' igualamos ancho de todas las filas y ponemos autofiltro
'xlSh.Range("A2:A" & xlSh.Rows.count).RowHeight = xlSh.Rows(1).RowHeight
On Error Resume Next ' evitar error en algunas tablets en autofilter
xlSh.Range("A1").AutoFilter
xlSh.Cells.Select
xlSh.Cells.EntireColumn.AutoFit
xlSh.Cells.EntireRow.AutoFit

End Sub
Private Sub pintarExcel(xlSh As Object, rst As DAO.Recordset)
'Private Sub pintarExcel(xlSh As Excel.Worksheet, rst As DAO.Recordset)

Dim iCols As Integer ' xls empieza en 1
Dim iRows As Integer ' xls empieza en 1
For iCols = 0 To rst.Fields.count - 1
    If xlSh.Columns(iCols + 1).ColumnWidth > 50 Then xlSh.Columns(iCols + 1).ColumnWidth = 50 ' no tan anchas
    If Left(rst.Fields(iCols).Name, 4) = "Expr" And rst.Fields(iCols).Name <> "ExprTotal" Then ' estamos en una columna con valores de comparación
        xlSh.Cells(1, iCols + 1).Interior.ColorIndex = 34 ' otro azul
        For iRows = 1 To rst.RecordCount
            ' la primera fila son los campos
            If xlSh.Cells(iRows + 1, iCols + 1).Value < 1 Then
                xlSh.Cells(iRows + 1, iCols).Interior.ColorIndex = 6 ' o 27 , amarillos
                xlSh.Cells(iRows + 1, iCols - 1).Interior.ColorIndex = 6 ' o 27 , amarillos
            End If
            If iRows Mod 100 = 0 Then
                textLog.SetFocus
                textLog.Text = "Columna:" & iCols & " Fila: " & iRows & "/" & rst.RecordCount
                DoEvents
            End If
        Next
    End If
    If rst.Fields(iCols).Name = "ExprTotal" Then xlSh.Cells(1, iCols + 1).Interior.ColorIndex = 42 'azul
Next

End Sub
Private Sub rellenarExcel(xlSh As Object, rst As DAO.Recordset, row As Integer, comboCampo As String, comboTabla As String)
'Private Sub rellenarExcel(xlSh As Excel.Worksheet, rst As DAO.Recordset, row As Integer, comboCampo As String, comboTabla As String)
Dim col As Integer
Dim count As Integer
Dim i As Integer
Dim valor As Variant


If Not (rst.EOF And rst.BOF) Then
    rst.MoveLast
    rst.MoveFirst
    count = rst.RecordCount
    i = 1
    For Each valor In rst.Fields
        xlSh.Cells(row, i) = valor.Name
        ' paleta de colores https://www.excel-easy.com/vba/examples/background-colors.html
        xlSh.Cells(row, i).Interior.ColorIndex = 15 'gris
        i = i + 1
    Next
    row = row + 1
      
    Do Until rst.EOF
        i = 1
        For Each valor In rst.Fields
            If Not IsNull(valor.Value) Then
                xlSh.Cells(row, i) = valor.Value
            Else
                xlSh.Cells(row, i) = ""
            End If
            i = i + 1
        Next
        xlSh.Rows(row).RowHeight = xlSh.Rows(1).RowHeight
        If row Mod 50 = 0 Then
            textLog.Text = " Diifs, Fila: " & row & "/" & count
            DoEvents
        End If
    row = row + 1
    rst.MoveNext
    Loop
End If
xlSh.Range("A1").AutoFilter
xlSh.Cells.Select
xlSh.Cells.EntireColumn.AutoFit
xlSh.Cells.EntireRow.AutoFit
End Sub

Private Sub comboTablas1_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim comboName As Variant
If IsNull(comboTablas1) Or comboTablas1 = "" Then Exit Sub


'Limpiar combobox campos
While comboCampo1.ListCount > 0
    comboCampo1.RemoveItem 0
    For Each comboName In Split(camposCombo1, ",")
        Me.Controls(comboName).RemoveItem 0
    Next
Wend

comboCampo1 = ""
For Each comboName In Split(camposCombo1, ",")
        Me.Controls(comboName) = ""
Next
    
Set db = CurrentDb()
Set rst = db.OpenRecordset(comboTablas1)
Dim fld As DAO.Field
For Each fld In rst.Fields
    comboCampo1.AddItem (fld.Name)
    For Each comboName In Split(camposCombo1, ",")
        Me.Controls(comboName).AddItem (fld.Name)
    Next
Next
rst.Close
Set fld = Nothing
Set rst = Nothing
Set db = Nothing


End Sub

Private Sub comboTablas2_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim comboName As Variant

If IsNull(comboTablas2) Or comboTablas2 = "" Then Exit Sub


'Limpiar combobox
While comboCampo2.ListCount > 0
    comboCampo2.RemoveItem 0
    For Each comboName In Split(camposCombo2, ",")
        Me.Controls(comboName).RemoveItem 0
    Next
Wend

comboCampo2 = ""
For Each comboName In Split(camposCombo2, ",")
        Me.Controls(comboName) = ""
Next

Set db = CurrentDb()
Set rst = db.OpenRecordset(comboTablas2)
Dim fld As DAO.Field
For Each fld In rst.Fields
    comboCampo2.AddItem (fld.Name)
    For Each comboName In Split(camposCombo2, ",")
        Me.Controls(comboName).AddItem (fld.Name)
    Next
Next
rst.Close
Set fld = Nothing
Set rst = Nothing
Set db = Nothing


End Sub

Private Sub Form_Load()
Dim comboName As Variant
Set db = CurrentDb()
comboTablas1.RowSource = ""
comboCampo1.RowSource = ""
comboTablas2.RowSource = ""
comboCampo2.RowSource = ""

For Each comboName In Split(camposCombo1, ",")
        Me.Controls(comboName).RowSource = ""
Next
For Each comboName In Split(camposCombo2, ",")
        Me.Controls(comboName).RowSource = ""
Next

For Each td In db.TableDefs
    If Left(td.Name, 4) <> "MSys" And td.Name <> "RegExp" Then
        comboTablas1.AddItem (td.Name)
        comboTablas2.AddItem (td.Name)
    End If
Next td

CheckboxTabla1.Value = False
CheckboxTabla2.Value = False
checkBoxLimpiar.Value = False
checkBoxInOut.Value = False

Set td = Nothing
Set db = Nothing

End Sub

Private Sub quitarNulos(tablaName As String)
'https://stackoverflow.com/questions/29064325/replacing-null-values-for-multiple-columns-in-a-table-with-a-constant-value
Dim db As DAO.Database
Dim fld As DAO.Field
Dim tdf As DAO.TableDef

Dim strUpdate As String

Dim campoBusqueda As String
Dim camposBusqueda(20) As String
Dim i As Integer

Set db = CurrentDb
Set tdf = db.TableDefs(tablaName)

' Array con los campos de búsqueda, para comprobar si estamos en uno de ellos, en las tablas a comparar

' para la tabla1
i = 0
If tablaName = comboTablas1.Value Then
    i = 0
    For Each valor In Split(camposCombo1, ",")
        If Not IsNull(Me.Controls(valor)) Then
            camposBusqueda(i) = Me.Controls(valor)
        Else
            camposBusqueda(i) = ""
        End If
        i = i + 1
    Next
End If
' para la tabla 2
i = 0
If tablaName = comboTablas2.Value Then
    For Each valor In Split(camposCombo2, ",")
        If Not IsNull(Me.Controls(valor)) Then
            camposBusqueda(i) = Me.Controls(valor)
        Else
            camposBusqueda(i) = ""
        End If
        i = i + 1
    Next
End If


For Each fld In tdf.Fields
    ' Access will complain if you attempt an UPDATE on an autonumber field,
    ' so skip field with dbAutoIncrField attribute
    If Not ((fld.Attributes And dbAutoIncrField) = dbAutoIncrField) Then
        ' ver además si es un campo de búsqueda
        i = 0
        Do While camposBusqueda(i) <> ""
            If fld.Name = camposBusqueda(i) Then
                ' convertir a tipo texto
                If fld.Type <> dbText Then ' cazamos los números y los memo
                    MsgBox "Se va a cambiar el tipo de datos de " & fld.Name & " de la tabla " & tablaName & " a TEXTO", vbExclamation
                    db.Execute "ALTER TABLE [" & tablaName & "] ALTER COLUMN [" & fld.Name & "] TEXT;"
                End If
                ' cambiar si es nulo y poner cadena vacía
                    strUpdate = "UPDATE [" & tablaName & "] SET [" & fld.Name & _
                        "] = """" WHERE [" & fld.Name & "] Is Null;"
                    '   "] = -99999 WHERE [" & fld.Name & "] Is Null;"
                    'Debug.Print strUpdate
                    db.Execute strUpdate, dbFailOnError
            End If
        i = i + 1
        Loop
        
    End If
    
Next

End Sub