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
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