Saltar al contenido

Exportar datos excel a access


xveganx

Recommended Posts

publicado

Buenos días, acudo a los mas sabios en Macros porque he buscado información por muchos lados  y la verdad siempre encuentro cosas diferente y me esta costando escoger el camino correcto y quería saber si es que ustedes pueden tirarme un destello de luz en esta incertidumbre. 

Quiero exportardatos de una hoja de excel a una tabla de access ya creada en una base de datos. 
La tabla tiene la misma cantidad de campos, que columnas el archivo excel, cada uno con el mismo nombre. 

CONTRATO    CONTRATO SAP    FECHA    PROVEEDOR    SUCURSAL    DESCRIPCION    MONEDA

El archivo es una lista de proveedores y sus contratos correspondientes, y datos sobre los mismos. 
La idea es bajar del sistema la informacion y exportarla mediante una macro sin la necesidad de realizar ese traspaso de datos de manera manual y que cada vez que la exporte la informacion vieja se borre y quede la nueva. 

Pero en cada ejemplo que he visto o he bajado y tratado de adaptar a la situacion surge algo y mi falta de conocimientos en codigo VBA me estanca y queria saber si alguien tiene o posee algun archivo que funcione bajo estas condiciones o algun tutorial que me permita aplicar lo que quiero. 

Desde ya muchisimas gracias. 

publicado

Hola @xveganx, para tener un mayor entendimiento sobre las consultas siempre se solicita un archivo de ejemplo, en tu caso la tabla de access y el excel, con datos ficticios es suficiente ya que lo se requiere es ver la estructura de tus archivos.

Te dejo un pequeño código que hace lo que quieres, siempre y cuando lo sepas adaptar a tu archivo.

Sub Exp_ACCESS()

  Set cn = CreateObject("ADODB.Connection")
  
  dbPath = "C:\Users\Usuario\Documents\Database1.accdb" '>>> RUTA de la BD
  
  Tabla = "Tabla1" ' >>> Nombre de la tabla de Access
  
  dbWb = Application.ActiveWorkbook.FullName
  dbWs = Application.ActiveSheet.Name
  scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
  dsh = "[" & Application.ActiveSheet.Name & "$]"
  cn.Open scn
  
  ssql = "Delete * From " & Tabla
  
  cn.Execute ssql
  
  ssql = "INSERT INTO " & Tabla & " ([CONTRATO], [CONTRATO SAP], [FECHA], [PROVEEDOR], [SUCURSAL], [DESCRIPCION], [MONEDA]) "
  ssql = ssql & "SELECT [CONTRATO], [CONTRATO SAP], [FECHA], [PROVEEDOR], [SUCURSAL], [DESCRIPCION], [MONEDA]" & _
  " FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh

  cn.Execute ssql
  
  MsgBox "Listo !!", vbInformation

End Sub

Saludos.

publicado

Antes que nada, muchas gracias por tu respuesta Alexander. 

No habia agregado los archivos porque la base de datos es muy grande  (pesa cerca de 2 gb ya que no solo tiene la tabla de informacion sobre los contratos si no que varios datos mas. lo que hice fue copiar la tabla en una base nueva y segmente el archivo excel  los cuales adjunto. 

Utilice el código que me dijiste, y le agregue las columnas que faltaban a la descripción. 

Cita

Sub Actualizar_Cttos()

  Set cn = CreateObject("ADODB.Connection")
  
  dbPath = "C:/Ubicacion en red/Seguimiento.mdb"
  
  Tabla = "Cttos" '
  
  dbWb = Application.ActiveWorkbook.FullName
  dbWs = Application.ActiveSheet.Name
  scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
  dsh = "[" & Application.ActiveSheet.Name & "$]"
  cn.Open scn
  
  ssql = "Delete * From " & Tabla
  
  cn.Execute ssql
  
  ssql = "INSERT INTO " & Tabla & " ([CONTRATO], [CONTRATO SAP], [FECHA], [PROVEEDOR], [SUCURSAL], [DESCRIPCION], [MONEDA], [IMPORTE], [MONTO DISPONIBLE], [TC], [IMPORTE ACRODADO PES], [MONTO DISPONIBLE PES], [VIGENCIA DESDE], [VIGENCIA HASTA], [AUXILIAR], [GESTOR], [ESTADO APROBACION], [CUADRANTE], [TIPO CONTRATO], [SECTOR], [CONTROL], [ACTIVOS], [SPOT/ON CALL], [INDIRECTOS], [TERCEROS], [REEMPLAZOS], [COPIA_DW], [CLASE], [COMPRADOR]) "
  ssql = ssql & "SELECT [CONTRATO], [CONTRATO SAP], [FECHA], [PROVEEDOR], [SUCURSAL], [DESCRIPCION], [MONEDA], [IMPORTE], [MONTO DISPONIBLE], [TC], [IMPORTE ACRODADO PES], [MONTO DISPONIBLE PES], [VIGENCIA DESDE], [VIGENCIA HASTA], [AUXILIAR], [GESTOR], [ESTADO APROBACION], [CUADRANTE], [TIPO CONTRATO], [SECTOR], [CONTROL], [ACTIVOS], [SPOT/ON CALL], [INDIRECTOS], [TERCEROS], [REEMPLAZOS], [COPIA_DW], [CLASE], [COMPRADOR]" & _
  " FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh

  cn.Execute ssql
  
  MsgBox "Listo !!", vbInformation

End Sub

Al ejecutar la macro me arroja el siguiente error:

Cita


Se ha producido el error '-2147217904 (80040e10)' en tiempo de ejecucion
No se han especificado valores para algunos de los parametros requeridos

 

Al darle depurar, me subraya la siguiente linea:

cn.Execute ssql

Cita

Intente cargar los archivos al foro pero solo permite hasta 102kb asi que adjunto los archivos desde google Drive. 

https://drive.google.com/open?id=1yqqTNLUYbuckHpOXfQj7bP1extMvT1zn

 

publicado
Hace 1 hora, xveganx dijo:

Se ha producido el error '-2147217904 (80040e10)' en tiempo de ejecucion
No se han especificado valores para algunos de los parametros requeridos

Este error se da cuando en la tabla de access hay columnas que no existen o tienen un nombre distinto en la hoja de excel, debes revisar que todos los campos están dentro de los 2 archivos y que se llamen igual tomando en cuenta mayúsculas y minúsculas.

Hace 1 hora, xveganx dijo:

Intente cargar los archivos al foro pero solo permite hasta 102kb asi que adjunto los archivos desde google Drive. 

https://drive.google.com/open?id=1yqqTNLUYbuckHpOXfQj7bP1extMvT1zn

Los archivos que compartiste, el libro de excel no tienen ninguna hoja relacionada a la tabla de access, no se si fue un error al subir el archivo o no te entendí algo.

Te tejo el ejemplo de como debería funcionar el código que te compartí, debes ejecutar la macro "Actualiza_Cttos" en la hoja "Datos a Exportar"

Saludos.

Prueba cttos.zip

publicado

Muchas gracias Alexander por tomarte este tiempo para mi problema. 

Ejecute los archivos que me pasaste sin problemas... pero al querer cambiar la ruta de la DB (el archivo excel se encuentra en una carpeta diferente a la base de datos.. esta ultima se encuetra en una ubicacion en una red compartida) me vuelve a saltar un error. 

En la macro de la hoj original (la tuya) cambie y puse la ruta de la base de datos en la red y me sale error nuevamente y al poner el depurador señala   cn.Open scn

 

Mi consulta es, esta macro no sirve si los archivos no comparten la misma carpeta? 

 

publicado
Hace 2 minutos , xveganx dijo:

Muchas gracias Alexander por tomarte este tiempo para mi problema. 

Ejecute los archivos que me pasaste sin problemas... pero al querer cambiar la ruta de la DB (el archivo excel se encuentra en una carpeta diferente a la base de datos.. esta ultima se encuetra en una ubicacion en una red compartida) me vuelve a saltar un error. 

En la macro de la hoj original (la tuya) cambie y puse la ruta de la base de datos en la red y me sale error nuevamente y al poner el depurador señala   cn.Open scn

 

Mi consulta es, esta macro no sirve si los archivos no comparten la misma carpeta? 

 

Debes de estar escribiendo mal la ruta de la BD, no afecta que el archivo este en en la red siempre y cuando tengas permisos para acceder a ella.

Lo que suelo hacer para no equivocarme al escribir la ruta es usar esta opción del explorador de archivos 

image.png.37106c28a8a40a07dc2a65bbbebd4700.png

Saludos.

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29

    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • Exelente solución mil gracias 
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.