5

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 introducir la descripción de la imagen aquí

introducir la descripción de la imagen aquí

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 introducir la descripción de la imagen aquí

**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 introducir la descripción de la imagen aquí

Saludos comunidad, espero me puedan ayudar con esto.

1 respuesta 1

6

Estoy trabajando sobre esta macro pero aun no logro hacerla funcionar

Esa descripción es vaga, imprecisa y confusa. Por favor, la próxima vez da más detalles, qué tipo de error, que esperas que haga y que parte falla. Entiendo que falla el añadir registros nuevos.

He simplificado mucho el código. Yo accedo mediante DAO aprovechando que usas VBA y tienes Access instalado, aprovecho las propias herramientas de Access en vez de acceder mediante ADO como tú.

Mi código se conecta a la base de datos y cuenta, usando DCOUNT si el registro existe según tu criterios. Si no existe, entonces lo inserta mediante SQL.

Nada más.

Te dejo un par de enlaces por si acaso:

Método Application.DCount (Access)

SQL INSERT INTO Statement

He replicado tu bbdd de una manera sencilla. Mis datos son:

introducir la descripción de la imagen aquí

Y mi excel:

introducir la descripción de la imagen aquí

Las dos filas amarillas son las que no existen en la base y, por lo tanto, quiero que se añadan automáticamente. El código:

Sub TEST()
Dim i As Long
Dim UF As Long
Dim AppAccess As Variant
Dim MiSQL As String
Dim Ruta As String
Dim ClaseDem As String
Dim TotalRegistros As Long

Ruta = "D:\Temp\test.accdb" '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.DCount("[DESCRIPCION_DOMINIO]", "CAT_DOMINIO_REFERENCIA") + 1 'total registros de la tabla para el campo INTERNO_DOMINIO
        
        MiSQL = "INSERT INTO CAT_DOMINIO_REFERENCIA (INTERNO_DOMINIO, DESCRIPCION_DOMINIO, PALABRA_CLAVE) VALUES (" & TotalRegistros & ", '" & ClaseDem & "', '" & ClaseDem & "')"
        With AppAccess
            .DoCmd.SetWarnings False 'DESACTIVAMOS AVISO VISUAL
            .DoCmd.RunSQL MiSQL 'insertamos mediante SQL
            .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

Y el output que consigo cuna vez ejecutado:

introducir la descripción de la imagen aquí

Sobre lo 2º que preguntas,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? te recomiendo que abras otra pregunta con eso. Preguntar muchas cosas en una sola pregunta no es correcto.

8
  • 2
    funciono perfecto justo como esperaba, le hice algunos ajustes para obtener en la variable TotalRegistros = AppAccess.DMax("[INTERNO_DOMINIO]", "CAT_DOMINIO_REFERENCIA") + 1 'el registro maximo de la tabla para el campo INTERNO_DOMINIO; tendré en cuenta tus recomendaciones al momento de hacer una nueva pregunta. Gracias por tu tiempo en este post, se aprende y se comparte mucho. Commented el 20 jun. 2021 a las 16:36
  • 1
    Les comparto, pude agregar a la macro Update dada por @Esei el agregar registros a la tabla CAT_CATALOGO asociados a la tabla CAT_DOMINIO_REFERENCIA, de la siguiente manera: 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 & ")" 'luego Insertando mediante SQL .DoCmd.RunSQL MyQuery .DoCmd.RunSQL MiConsulta. Commented el 20 jun. 2021 a las 16:44
  • 2
    @KarlaRojas si te ha funcionado, me alegro :) es bueno saberlo. ¡Gracias!
    – Esei
    Commented el 20 jun. 2021 a las 17:18
  • 2
    @dogwall Que yo sepa, sin Access instalado, no se podría crear la clase AppAccess y acceder a sus métodos y propiedades. Por lo tanto, no tendríais Dcount disponible..
    – Esei
    Commented el 21 jun. 2021 a las 8:29
  • 1
    @dogwall Pero sí deberíais poder acceder mediante ADO y hacer peticiones SQL. Yo prefiero DAO porque lo conozco mejor y simplifico, pero ADO también tiene sus cosas. En vez de Dcount, se puede hacer un SELECT..WHERE y contar cuántos registros hay y esas cosas.
    – Esei
    Commented el 21 jun. 2021 a las 8:35

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.