Problema al importar datos de Excel a Access

[Pirtrafilla]

Hola a todos.

Tengo un problema. Estoy intentando hacer un archivo en Excel donde a  través de un cuadro de diálogo abro un archivo Excel y quiero importar esos datos a Access.

Como estoy haciendo pruebas solo intento importar varios campos, pero no consigo hacerlo. Me da este error:

El código que estoy intentando hacer funcionar es este, que no es obra mía, he encontrado en la Red y he intentado adaptarlo.

Option Explicit
'
Public Conn, Sql$, rs_AV, Rs2 As Object, Rst As Recordset
'

Sub Conexión()
'
On Error Resume Next: Rst.Close: rs_AV.Close: Rs2.Close: Conn.Close: On Error GoTo 0
Set Conn = CreateObject("adodb.Connection")
Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
  "C:\Users\mllaveria\Desktop\Bd Checklist\DatabaseGC.accdb" & ";Jet OLEDB"
Set Rst = CreateObject("adodb.RecordSet")

On Error Resume Next
  Rst.Close: rs_AV.Close: Rs2.Close: Conn.Close
  Set Rst = Nothing: Set Rs2 = Nothing
  Set rs_AV = Nothing: Set Conn = Nothing: DoEvents
On Error GoTo 0
End Sub

Sub ImportarSie()
'
Dim Tmp, ws As Worksheet
Dim Mat, Q&, i&, R&
 
Tmp = "Selecciona el archivo....xlsx"
If MsgBox(Tmp & "...", vbOKCancel) = vbCancel Then GoTo Fin

Tmp = Application.GetOpenFilename("archivo (*.xlsx), *.xlsx", Title:=Tmp)
If Tmp = False Then GoTo Fin
  
Set ws = CreateObject("Excel.Application").Workbooks.Open(Tmp, ReadOnly:=True).Sheets(1)
Mat = ws.Range("a1").CurrentRegion: Q = UBound(Mat)
ws.Parent.Parent.Quit: DoEvents
If Q = 1 Then GoTo Fin

 If Rst.State Then Rst.Close
  Rst.Open "Select * From [Contable]", Conn, 3, 3, 1
  
  For i = 2 To Q
    With Rst
      .AddNew
      .Fields(0) = Mat(i, 1)
      .Fields(1) = Mat(i, 2)
      .Fields(2) = Mat(i, 3)
      .Update
    End With
  Next
  
  MsgBox "Importación terminada."
Fin:
'
Set ws = Nothing: Mat = Empty
End Sub

Y lo ejecuto al hacer click en un botón que tiene este código:

Private Sub CommandButton1_Click()
'
Conexión
ImportarSie
'
End Sub

Subo el archivo de prueba.

Agradezco la ayuda que me podáis dar.

Moisés.

 

Importar.xlsm

[Pirtrafilla]

Hola, ya he encontrado el error. 

On Error Resume Next
  Rst.Close: rs_AV.Close: Rs2.Close: Conn.Close
  Set Rst = Nothing: Set Rs2 = Nothing
  Set rs_AV = Nothing: Set Conn = Nothing: DoEvents
On Error GoTo 0

Estas líneas las he quitado, porque lo que hacía es cerrar la conexión. Como lo copié de un sitio web y no entendía todo lo que hacía no me di cuenta que esto sobraba.

He añadido algo más de código.

Ahora ya consigo importar los datos a base de Access, pero tengo otra necesidad. No quiero importar los datos repetidos. Es decir, si ya he importado el fichero y vuelvo a importar no debería cargar los datos que se repitan, y para ello en el Excel que importo las columnas que necesitar comparar para no añadir el registro nuevo sería las columnas, 1, 3, 13 y 14.

Es decir que si el valor de estas columnas ya están en la base de datos no debería cargar esta fila. Entiendo que en la tabla de la base de datos de la columna 1 del Excel corresponde al field 0, la columna 3 al field 2, etc...

No se como hacer la consulta para que si encuentra estas coincidencias no añada el registro.

 Vuelvo a subir el archivo con la macro para pediros de nuevo ayuda.

Por si acaso os dejo el código aquí también.

Option Explicit
'
Public Conn, Sql$, rs_AV, Rs2 As Object, Rst As Recordset
'

Sub Conexión()
'
On Error Resume Next: Rst.Close: rs_AV.Close: Rs2.Close: Conn.Close: On Error GoTo 0

Set Conn = New ADODB.Connection

Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
  "C:\Users\mllaveria\Desktop\Bd Checklist\DatabaseGC.accdb" & ";Jet OLEDB"

Set Rst = New ADODB.Recordset

On Error GoTo 0
End Sub

Sub ImportarSie()
'
Dim Tmp, ws As Worksheet
Dim Mat, Q&, i&, R&, x&
 
Tmp = "Selecciona el archivo....xlsx"
If MsgBox(Tmp & "...", vbOKCancel) = vbCancel Then GoTo Fin

Tmp = Application.GetOpenFilename("archivo (*.xlsx), *.xlsx", Title:=Tmp)
If Tmp = False Then GoTo Fin
  
Set ws = CreateObject("Excel.Application").Workbooks.Open(Tmp, ReadOnly:=True).Sheets(1)
Mat = ws.Range("a1").CurrentRegion: Q = UBound(Mat)
ws.Parent.Parent.Quit: DoEvents
If Q = 1 Then GoTo Fin

If Rst.State Then Rst.Close
Rst.Open "Select * From [Contable]", Conn, 3, 3, 1
  
 For i = 2 To Q
    With Rst
      .AddNew
       For x = 1 To 20
        .Fields(x - 1) = Mat(i, x)
       Next x
      .Update
    End With
  Next
  
  MsgBox "Importación terminada."
  Rst.Close: Set Rst = Nothing
Fin:

Set Conn = Nothing: DoEvents
Set ws = Nothing: Mat = Empty
End Sub

Gracias por adelantado.

Moisés.

 

Importar.xlsm

[Antoni]

Sin la base de datos Access, sin el archivo Excel con la información a exportar y sin explicar que entiendes tu por duplicado, va a ser complicado ayudarte.

[Pirtrafilla]

Hola @Antoni, un placer volver a saber de usted.

Le envío comprimido los archivos.

El archivo "Importar" es donde está el botón con la macro. La base de datos "DataBase", y un fichero de ejemplo a importar, "Archivo a importar".

En este último le he marcado en amarillo los campos que no deben coincidir al volver a cargar el fichero. Es decir, si vuelvo a cargar el fichero es posible contenga estas filas y más, lo que quiero es que las filas que ya cargué no vuelvan a cargarse en el Access, y lo que considero que son repetidos es aquellas filas que contengan estos 4 campos con el mismo valor.

Por ejemplo, en este caso, si vuelvo a cargar el mismo fichero no debería añadir ningún registro en la base de datos porque ya existen.

Tal y como lo tengo yo volvería a cargar todos los datos de nuevo.

Gracias de antemano.

Moisés.

Pruebas.7z

[Pirtrafilla]

Hola de nuevo. Envío parte del código con una breve explicación de lo que no consigo hacer.

Necesito vuestra ayuda.

If Q = 1 Then GoTo Fin

If Rst.State Then Rst.Close
Rst.Open "Select * From [Contable]", Conn, 3, 3, 1
 For i = 2 To Q
'Aqui tengo que hacer una consulta en la tabla [Contable], los campos PERIODO = mat(i,1), [CODIGO_OT] = mat(i,3),
'[CENTRO_CC] = mat(1,13) y [NRO_COMP] = mat(i,14)
'si el registro existe, entonces se ha de saltar el siguiente bucle e ir a 'Existe:
'If Rst.EOF = False Then GoTo Existe: 'Este código imagino que es correcto, pero me falta la cosulta
    With Rst
      .AddNew
       For x = 1 To 20
        .Fields(x - 1) = Mat(i, x)
       Next x
      .Update
      n = n + 1 'contador de registros añadidos
Existe:
    End With
  Next

El resto del código está más arriba con el archivo, en otro post anterior, pero vuelvo a enviar los archivos.

Gracias.

Moisés.

Pruebas.7z

[Antoni]

Prueba con el adjunto.

Importar.xlsm

[Pirtrafilla]

@Antoni , muchas gracias.

Es lo que necesitaba.

Además, la manera en como has ordenado el código me ayuda a entenderlo.

Lo dicho, muchas gracias.

PD: La consulta se puede dar por solucionada.

Moisés.

 

[ikanni]

Hola a todos,

Escribo por dar otra opinion diferente. Y ya que tienes la database con la tabla ¿Por que no importantas directamente desde access? En vez de crear conexiones ADO y todo eso..., Acces tiene la facilidad de que la exportación y la importación de datos con Excel lo tiene automatizado en su propio sistema.

Luego con cuatro ejecucuiones SQL selecciono, filtro o lo que quieras y las añado a la tabla Contable. COn todo en su sitio.

Con respecto a tu ejemplo, habria que hacer algun pequeño cambio para poder automatizarlo con garantias.Hay que añadir un ID a la excel y otro a la tabla Contable para el Index COmpuesto por los campos que querias filtrar (CONCEPTO,...) y hay una tabla auxliar para poder jugar con los registros. Te dejo un jemplo como para tu trabajo.

Espero que os sirva

DataBase.rar