Access - pasar datos de excell a access

 
Vista:

pasar datos de excell a access

Publicado por Pedrito (20 intervenciones) el 16/02/2011 13:26:45
Hola a todos,

Estoy con access, versión 2007. Estoy haciendo un programita, por el cual necesito comparar los datos que existen en un fichero excell con una tabla de access, y lo estoy realizando con visual basic, al pusar un botón este me realiza la comparación y si no está lo graba. Aquí os expongo lo que he puesto en el botón:

Private Sub Comando6_Click()

Dim Obj_Access As Access.Application
Set Obj_Access = New Access.Application
Dim nomFichXLS As String
nomFichXLS = Inputbox("Introduzca el nombre del BUS:")
'Obj_Access.DoCmd.OpenModule "Módulo1"
Dim miXls As Excel.Application
Dim miWb As Excel.Workbook
Dim miHoja As Excel.Worksheet
Dim i As Integer
Dim rs As Recordset
Dim comparacion As String

' Abrimos el Excel
Set miXls = New Excel.Application

' Abrimos el libro
On Error Resume Next
Set miWb = miXls.Workbooks.Open(nomFichXLS, False, True)
If Err <> 0 Then
MsgBox "Error al abrir el libro a importar." & vbCrLf & vbCrLf & Error$
On Error GoTo 0
miXls.Quit
Exit Sub
End If
On Error GoTo 0

' Seleccionamos la hoja
Set miHoja = miWb.Sheets("MEGABUS GENERAL AÑO 2010")

' Borramos el contenido de la tabla para volver a cargarla
'DoCmd.RunSQL "delete from Clientes" ' (o como se llame la tabla)
' Y la abrimos para insertar los nuevos datos
Set rs = CurrentDb().OpenRecordset("CLIENTES")

' Leemos del excel e insertamos en access
i = 2 ' Saltamos la primera línea que tendrá los títulos
rs.MoveFirst
Do While miHoja.Cells(i, 2) <> ""
Do While rs.EOF = False
comparacion = rs.Fields(0)
If rs.Find("comparacion =" & miHoja.Cells(i, 2)) Then
i = i + 1
rs.MoveFirst
Else
rs.AddNew
rs.Fields(0) = miHoja.Cells(i, 2)
rs.Fields(1) = miHoja.Cells(i, 20)
rs.Fields(2) = miHoja.Cells(i, 1)
rs.Fields(4) = miHoja.Cells(i, 19)
rs.Fields(5) = miHoja.Cells(i, 21)
rs.Fields(6) = miHoja.Cells(i, 22)
rs.Fields(7) = miHoja.Cells(i, 25)
rs.Fields(8) = miHoja.Cells(i, 24)
rs.Fields(9) = miHoja.Cells(i, 23)
rs.Fields(10) = miHoja.Cells(i, 29)
rs.Fields(11) = miHoja.Cells(i, 30)
rs.Fields(12) = miHoja.Cells(i, 31)
rs.Fields(13) = miHoja.Cells(i, 32)
rs.Fields(14) = miHoja.Cells(i, 27)
rs.Fields(15) = miHoja.Cells(i, 28)
rs.Fields(16) = miHoja.Cells(i, 26)
rs.Update
i = i + 1
rs.MoveFirst
End If
Loop
Loop

' Cerramos todo
rs.Close

Set miHoja = Nothing
miWb.Close
Set miWb = Nothing
miXls.Quit
Set miXls = Nothing

End Sub

Un saludo a todos,

Pedrito
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder