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ó.
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.
(http://i60.tinypic.com/2i26jxi.jpg)
Y el código que tengo para hacerlo es el siguiente:
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:
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.
Hola!
Tienes en cuenta que una consulta SQL INSERT tiene el siguiente formato (ejemplo)?
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!
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 & ")"
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.
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!