¿Cómo comprobar si existen valores desde rango de Excel en tabla de Access antes de cargar datos?

Estoy escribiendo una macro que carga valores desde Excel hacia tabla de base de datos en Access, lo que quiero que haga es que recorra un rango Range("D" & i).Value de valores en Excel validando que estén registrados en la tabla de Access CAT_DOMINIO_REFERENCIA, y si no existen agregar el registro de una forma especifica, la tabla CAT_DOMINIO_REFERENCIA tiene 3 campos, los cuales son INTERNO_DOMINIO , DESCRIPCION_DOMINIO , PALABRA_CLAVE, de estos solo se debe tener en cuenta la coincidencia de búsqueda con DESCRIPCION_DOMINIO el cual esta relacionado con el rango de validación de existencia en Excel, los otros dos campos se deben registrar en caso de que no halla coincidencia de búsqueda el valor "maximo +1" ya registrado esto en el caso del campo INTERNO_DOMINIO, y para campo de PALABRA_CLAVE debe registrarse el mismo valor de DESCRIPCION_DOMINIO.

Estoy trabajando sobre esta macro pero aun no logro hacerla funcionar

Sub Update()
Const Sig_DB As String = "SIG_2012.mdb"
Dim cnn As ADODB.Connection
Dim MyConn As String
Dim rs, rst As ADODB.Recordset
Dim QuerySql, ConsultaSql As String
Dim ClaseDem As String, i As Long
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & Sig_DB
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
With Sheets("DEM")
uf = .Range("D" & Rows.Count).End(xlUp).Row
End With
For i = 3 To uf
ClaseDem = Range("D" & i).Value
QuerySql = "Select* from CAT_DOMINIO_REFERENCIA where DESCRIPCION_DOMINIO = " & ClaseDem
ConsultaSql = "SELECT MAX(INTERNO_DOMINIO) FROM CAT_DOMINIO_REFERENCIA"
rst.Open ConsultaSql, Cnn, adOpenKeyset, adLockOptimistic
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseServer
.Open Source:=QuerySql, ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdText
If (.BOF And .EOF) Then
'No se encontraron coincidencias; añadir nuevo récord
.AddNew
!INTERNO_DOMINIO = rst.Fields(0).Value + 1
!DESCRIPCION_DOMINIO = ClaseDem
!PALABRA_CLAVE = ClaseDem
Else
'registro coincidente encontrado; continuar
End If
.Update
.Close
End With
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Next i
End Sub

A continuación muestro un ejemplo grafico de lo que quiero hacer

El rango de valores resaltados en Excel se deben validar si existen en la tabla de Access

Si no hay coincidencia en la busqueda QuerySql = "Select* from CAT_DOMINIO_REFERENCIA where DESCRIPCION_DOMINIO = " & ClaseDem se deben añadir, quedando de esta forma

**Nota: Es posible que en misma macro Update se añadan registros asociados a los ya agregados a otra tabla con nombre CAT_CATALOGO relacionada a la tabla CAT_DOMINIO_REFERENCIA?, la tabla CAT_CATALOGO tiene 2 campos de nombre INTERNO_TABLA_REFERENCIA, INTERNO_DOMINIO; a continuación muestro como debería quedar en caso de ser posible

Respuesta
1

Prueba esto,

Sub Update()
Dim i As Long
Dim Uf As Long
Dim AppAccess As Variant
Dim MiSQL, MyQuery, MiConsulta As String
Dim Ruta As String
Dim ClaseDem As String
Dim TotalRegistros As Long
Set a = Sheets("DEM")
Ruta = a.Range("B1").Value 'ruta a la base
Set AppAccess = CreateObject("Access.Application")
AppAccess.OpenCurrentDatabase Ruta, False 'abrimos base
DoEvents
With Sheets("DEM")
Uf = .Range("D" & .Rows.Count).End(xlUp).Row
End With
For i = 3 To Uf Step 1
ClaseDem = Sheets("DEM").Range("D" & i).Value
'primero comprobamos si ese valor existe en la tabla CAT_DOMINIO_REFERENCIA
If AppAccess.DCount("[DESCRIPCION_DOMINIO]", "CAT_DOMINIO_REFERENCIA", "[DESCRIPCION_DOMINIO]='" & ClaseDem & "'") = 0 Then
'si la cuenta de Dcount devuelve 0, significa que no existe ese valor en el campo DESCRIPCIÓN DOMINIO de la tabla CAT_DOMINIO_REFERENCIA
'entonces hacemos un INSERT INTO mediante inyección SQL
TotalRegistros = AppAccess.DMax("[INTERNO_DOMINIO]", "CAT_DOMINIO_REFERENCIA") + 1 'registro maximo de la tabla para el campo INTERNO_DOMINIO
MiSQL = "INSERT INTO CAT_DOMINIO_REFERENCIA (INTERNO_DOMINIO, DESCRIPCION_DOMINIO, PALABRA_CLAVE) VALUES (" & TotalRegistros & ", '" & ClaseDem & "', '" & ClaseDem & "')"
MyQuery = "INSERT INTO CAT_CATALOGO (INTERNO_TABLA_REFERENCIA, INTERNO_DOMINIO) VALUES (" & 96 & ", " & TotalRegistros & ")"
MiConsulta = "INSERT INTO CAT_CATALOGO (INTERNO_TABLA_REFERENCIA, INTERNO_DOMINIO) VALUES (" & 145 & ", " & TotalRegistros & ")"
With AppAccess
.DoCmd.SetWarnings False 'desactivamos aviso visual
''insertamos mediante SQL
.DoCmd.RunSQL MiSQL
.DoCmd.RunSQL MyQuery
.DoCmd.RunSQL MiConsulta
.DoCmd.SetWarnings True 'reactivamos avisos visuales
DoEvents
End With
Else
''registro coincidente encontrado; continuar. No hacemos nada
End If
Next i
'cerramos base una vez ternimenos y limpiamos variables
AppAccess.CloseCurrentDatabase
Set AppAccess = Nothing
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas