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
Saludos comunidad, espero me puedan ayudar con esto.