Importar datos desde Excel a Access con Vb6.0

[FranciskoAsdf]

Hola estimados,

Vengo a solicitar su ayuda para intentar resolver un problema que me tiene de cabeza, literalmente xD!

El tema es "super simple", quiero importar datos desde una planilla Excel a una tabla en Access, PERO no me funciona y no puedo saber porque.

Para intentar esclarecer un poco y me puedan entender, estos son los archivos que uso.

Una planilla Excel, donde los datos están distribuidos en 6 columnas sin formato (no es un archivo CSV). Probé poniendo el mismo nombre de los campos que en la base de datos, pero no funcionó.

Código [Seleccionar] Expandir


168914 asdf 28/11 30/11 4.890 3990
132112 asdf 28/11 30/11 4.890 40% DCTO
149955 asdf 28/11 30/11 4.890 40% DCTO
149956 asdf 28/11 30/11 4.890 40% DCTO
178377 asdf 28/11 30/11 4.890 40% DCTO
178379 asdf 28/11 30/11 4.890 40% DCTO
178380 asdf 28/11 30/11 4.890 40% DCTO
185147 asdf 28/11 30/11 4.890 40% DCTO
197620 asdf 28/11 30/11 4.890 40% DCTO
208424 asdf 28/11 30/11 4.890 40% DCTO


Y la base de datos Access.



Y el código que tengo para hacerlo es el siguiente:

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub cmdLoad_Click()
Dim excel_app As Object
Dim excel_sheet As Object
Dim db As Database
Dim new_value As String
Dim row As Integer

    Screen.MousePointer = vbHourglass
    DoEvents

    Set excel_app = CreateObject("Excel.Application")

'    excel_app.Visible = True

    excel_app.Workbooks.Open FileName:=txtExcelFile.Text

    If Val(excel_app.Application.Version) >= 8 Then
        Set excel_sheet = excel_app.ActiveSheet
    Else
        Set excel_sheet = excel_app
    End If

    Set db = OpenDatabase(txtAccessFile.Text)

    row = 1
    Do

        new_value = Trim$(excel_sheet.Cells(row, 1))

        If Len(new_value) = 0 Then Exit Do

        db.Execute "INSERT INTO BDOfertas VALUES (" & new_value & ")" ' ACA ES DONDE ME MARCA AL MOMENTO DE MOSTRAR EL ERROR EN TIEMPO DE EJECUCION. (LINEA 34)

        row = row + 1
    Loop

    db.Close
    Set db = Nothing


    excel_app.Quit
    Set excel_sheet = Nothing
    Set excel_app = Nothing

    Screen.MousePointer = vbDefault
    MsgBox "Copied " & Format$(row - 1) & " values."
End Sub

Private Sub Form_Load()
Dim file_path As String

    file_path = App.Path
    If Right$(file_path, 1) <> "\" Then file_path = file_path & "\"
    txtExcelFile.Text = file_path & "TEST.xls"
    txtAccessFile.Text = file_path & "CLLBD.mdb"
End Sub


Y el error que obtengo es el siguiente:

Código [Seleccionar] Expandir


Error '3346' en tiempo de ejecución:

El número de valores de consulta y el número de campos de destino son diferentes.



He intentado con muchos códigos hacer lo que quiero, pero nada parece funcionar, o yo lo estoy haciendo mal. Solo me falta esto para terminar este formulario del proyecto, pero no se como solucionarlo.


Atento a comentarios,
Atte.
Francisko.

[MCKSys Argentina]

Hola!

Tienes en cuenta que una consulta SQL INSERT tiene el siguiente formato (ejemplo)?

Código [Seleccionar] Expandir


INSERT INTO Tabla (Campo1, Campo2, Campo3, Campo4) VALUES ('Valor1','Valor2','Valor3','Valor4');


Revisa tu código, porque todo indica que estás haciendo mal la consulta...

Saludos!

[silver_axe007]

La respuesta es Sencilla ... cuando haces el Insert la tabla tiene 6valores y eso  espera que en values le pongas varios valores (numero de columnas) pero solo le envias una

espero te ayude.

"INSERT INTO BDOfertas VALUES (" & new_value & ")"

cuando deberia ser

"INSERT INTO BDOfertas VALUES (" & new_value1 & ", " &  new_value2 & ", " &  new_value3 & ", " &  new_value4 & ", " &  new_value5 & ", " &  new_value6 & ")"

[FranciskoAsdf]

Hola, sorry por la respuesta tan tarde, pero aunque si intente de la forma que me dices Silver_axe007 no me funcionó.
Al final lo pude hacer, con un poco de ayuda de Google.

Dejo el codigo por si a alguien mas le sirve.

Código (vb) [Seleccionar] Expandir


Ooption Explicit
Dim NewDB As Database
Dim NewTable As TableDef
Dim DBName As String
Dim dbnm As String
Dim db As Database
Dim rs As DAO.Recordset, nofld As Integer, norecd As Integer
Dim J As Long


      Set db = OpenDatabase(App.Path & "\DataAndStuff\" & dbnm)
      Set rs = db.OpenRecordset("BDOfertas")
      Do While Len(ExcelApp.ActiveSheet.Cells(i, 1).Value) <> 0
         J = 1
         rs.AddNew
         Do While Len(ExcelApp.ActiveSheet.Cells(i, J).Value) <> 0
            rs.Fields(J - 1).Value = ExcelApp.ActiveSheet.Cells(i, J).Value
            J = J + 1
         Loop
         rs.Update
         i = i + 1
      Loop

Saludos!