De Listbox a Tabla Acces Sin bucles

[giordancisco]

Como va? estoy intentando mandar los datos de un listbox de excel a una tabla de acces. Se me ocurrió hacerlo directamente, es decir mandar en una sentencia SQL el total del contenido del listbox a la base de datos acces.

He intentado lo siguiente pero no funciona: 

Sql = "INSERT INTO Entradas (Cod,[Descripción],[Cantidad],[PrecioUnitario],SubTotal,[Recibo],Vendedor,Proveedor,Operación) VALUES (me.ListBox1.Column)"

o 

Sql = "INSERT INTO Entradas (Cod,[Descripción],[Cantidad],[PrecioUnitario],SubTotal) VALUES ('" Me.ListBox1.Column(0), & '" & Me.ListBox1.Column(1) & "','" & Me.ListBox1.Column(2) & "','" & Me.ListBox1.Column(3) & "','" & Me.ListBox1.Column(4) & "')"

Tambien he intentado reemplazar el VALUES por SELECT pero tampoco funciona

Desde ya si me pueden orientar con esto les estaré eternamente agradecido. Saludos

El formulario se llama "COMPRAS"

https://drive.google.com/file/d/1S-ioBt0-68P8w77RDk9TOJOpLLVEFMNh/view?usp=sharing

base de datos acces: https://drive.google.com/file/d/1x9S6956OdjK6ZShvD2LOG0XFwY3l0o1G/view?usp=sharing

[Antoni]

Hasta donde yo se, no existe la posibilidad de cargar una tabla de forma directa desde un listbox sin un bucle.

Sería algo así (No está probado)

Private Sub procesar_Click()
'Debe existir una conexión abierta de la BD con el nombre Conexion
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
End With
'..
With ListBox1
   For X = 0 To .listcount1 - 1
      Sql = "INSERT INTO Entradas Values("
      Sql = Sql & "'" & .List(X, 1) & "',"
      Sql = Sql & "'" & .List(X, 2) & "',"
      Sql = Sql & CLng(.List(X, 0)) & ","
      Sql = Sql & CCur(.List(X, 3)) & ","
      Sql = Sql & CCur(.List(X, 4)) & ")"
      rs.Open Sql, Conexion
   Next
End With
'..
rs.Close
Set rs = Nothing
End Sub

 

[giordancisco]

Hace 1 hora, Antoni dijo:

Hasta donde yo se, no existe la posibilidad de cargar una tabla de forma directa desde un listbox sin un bucle.

Sería algo así (No está probado)

Private Sub procesar_Click()
'Debe existir una conexión abierta de la BD con el nombre Conexion
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
End With
'..
With ListBox1
   For X = 0 To .listcount1 - 1
      Sql = "INSERT INTO Entradas Values("
      Sql = Sql & "'" & .List(X, 1) & "',"
      Sql = Sql & "'" & .List(X, 2) & "',"
      Sql = Sql & CLng(.List(X, 0)) & ","
      Sql = Sql & CCur(.List(X, 3)) & ","
      Sql = Sql & CCur(.List(X, 4)) & ")"
      rs.Open Sql, Conexion
   Next
End With
'..
rs.Close
Set rs = Nothing
End Sub

 

Gracias Antoni, Al final lo termine resolviendo con un bucle, voy a probar tu alternativa seguro esta mejor!. Tuve un problema con algunos valores ya que algunos productos vienen con pulgadas y por lo tanto llevan la comilla simple ' que me anula la sentencia sql, investigando vi que utilizando parameters pero no conseguí adaptar las sentencias de esa forma. Al final termine utilizando replace.
Adjunto a continuación el código que estoy utilizando ahora para quien le pueda servir:

'ESTO ES PARA LA TABLA ENTRADAS ACCES
Dim Base As String
Dim Sql As String

Dim Conexion As String
Conexion = "PROVIDER=MICROSOFT.ACE.OLEDB.12.0;DATA SOURCE =" & Sheets("ACCES").Cells(1, 2).Text & ";PERSIST SECURITY INFO FALSE;"

'LLAMAMOS AL OBJETO ADO
Set cn = New ADODB.Connection
'ABRIMOS LA CONEXION
cn.Open Conexion
'CREAMOS LA CONSULTA
'('" &  & "')"
Dim descrip As String
For i = 0 To Me.ListBox1.ListCount - 1

descrip = Replace(Me.ListBox1.List(i, 2), "'", "''")

'Sql = "INSERT INTO Entradas (Cod,[Descripción],[Cantidad],[PrecioUnitario],SubTotal,[Recibo],Vendedor,Proveedor,Operación) VALUES me.ListBox1.Column"
'Sql = "INSERT INTO Entradas (Cod,[Descripción],[Cantidad],[PrecioUnitario],SubTotal) VALUES (Me.ListBox1.Column(0), & '" & Me.ListBox1.Column(1) & "','" & Me.ListBox1.Column(2) & "','" & Me.ListBox1.Column(3) & "','" & Me.ListBox1.Column(4) & "')"

Sql = "INSERT INTO Entradas (Cod,[Descripción],[Cantidad],[PrecioUnitario],SubTotal,[Recibo],Fecha,Vendedor,Proveedor,Operación) VALUES ('" & Me.ListBox1.List(i, 1) _
& "','" & descrip & "','" & Me.ListBox1.List(i, 0) & "','" & Me.ListBox1.List(i, 3) _
& "','" & Me.ListBox1.List(i, 4) & "','" & Me.recibo & "','" & Me.fecha & "','" & Me.vendedor _
& "','" & Me.ComboBox1 & "','" & Me.codnumero.Caption & Me.TextBox1 & "')"

'GUARDAR LA CONSULTA
cn.Execute Sql

Next

'CERRAMOS LA CONEXION
cn.Close
Set cn = Nothing

MsgBox "Compra registrada Exitosamente."

 

[Héctor Miguel]

Hace 23 horas, giordancisco dijo:

... mandar en una sentencia SQL el total del contenido del listbox a la base de datos acces.

He intentado lo siguiente pero no funciona: 

Sql = "INSERT INTO Entradas (Cod,[Descripción],[Cantidad],[PrecioUnitario],SubTotal,[Recibo],Vendedor,Proveedor,Operación) VALUES (me.ListBox1.Column)"

si quieres evitar bucles para transferir elementos de un control de lista (una columna) en formularios a valores "textuales" (separados por comas) para usarlos en sentencias SQL del tipo "VALUES (..." se requiere:

• pasar los elementos a un rango en alguna hoja
• concatenar su contenido (función Join de VBA)
• limpiar el rango (para otra ocasión ?)

p.ej. esto en algún lugar en el módulo de código de tu formulario (asumiendo que la fila 1 de la hoja activa está libre):

  Dim datos, n As Long, SQLvalues As String
  With ListBox1: datos = .Column: n = .ListCount: End With
  With [a1].Resize(, n): .Value = datos
    datos = Evaluate("transpose(transpose(" & .Address & "))")
    SQLvalues = Join(datos, ","): .ClearContents: End With

después insertas la variable (SQLvalues) donde le toca en la sentencia SQL (p.ej.)

Sql = "insert into Entradas (Cod,[Descripción],[Cantidad],[PrecioUnitario],SubTotal,[Recibo],Vendedor,Proveedor,Operación) values (" & SQLvalues & ")"

obviamente, con las (posibles) salvedades del caso (techas y otro tipo de datos ?)

saludos,
hector.

[giordancisco]

Gracias Hector, lo voy a probar.