Exportar datos de una tabla de access a excel mediante una macro VBA
A tod@s,
Hoy presento una situación que no he podido resolver y espero con su ayuda poder solucionarlo, el problema es el siguiente, tengo que pasar cada mes datos que están en una base de datos que se cambia cada 24 horas, es decir en un mes se generan 30 tablas en formato .mdb lo que hago es importarlas manualmente despues juntarlas en un solo archivo para generar algunos graficos de comportamiento, lo cual es muy tardado, eh intentado lo siguiente:
Tengo una macro que me lista la ruta y nombre de estos archivos en la hoja1.
Despues grabé la siguiente macro para exportar de archivo .mdb a excel:
Sub openaccess()
'
' openaccess Macro
'
'
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=\\B0565S02\Groupfiles\Common\Formacion&Acabado\AF\TFX\hi" _
, _
"storial\History20190131.mdb;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path=""""" _
, _
";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Je" _
, _
"t OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt D" _
, _
"atabase=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Je" _
, _
"t OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypas" _
, "s ChoiceField Validation=False"), Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdTable
.CommandText = Array("TestResults")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = _
"\\B0565S02\Groupfiles\Common\Formacion&Acabado\AF\TFX\historial\History20190131.mdb"
.ListObject.DisplayName = "Table_History20190131"
.Refresh BackgroundQuery:=False
End With
End Sub
Despues esa macro la etido con agregando el siguiente código:
Sub openaccess()
'
' openaccess Macro
'
rutaO=WorkSheets("Sheet1").Range("A1").Value
ActiveWorkbook. Worksheets. Add
Y sustituyo las direcciónes con la variable rutaO, para despues hacer un loop que vaya recorriendo todas las celdas y haga el mismo proceso hasta que haya una celda sin datos y obviamente tambien cambiaria el .ListObject.DisplayName = por una variable
Pero al hacer esto, me manda una serie de mensajes para obtener los datos.
1 Respuesta
¿Has probado a exportarla desde Access usando
Docmd.TransferSpreadsheet...
Ver https://docs.microsoft.com/es-es/office/vba/api/access.docmd.transferspreadsheet
Gracias por el interes, fijate que sí y si me funciona desde access, pero no se como importar todas las tablas de forma masiva, porque de lo contrario tengo que agregar cada tabla manualmente.
Lo que estoy viendo es que aunque la variable rutaO si toma el dato de la dirección en este codigo:
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source= rutaO" _
, _
"storial\History20190131.mdb;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path=""""" _
ese código no toma el valor de la variable, es por eso que al correr la macro me mando un formulario donde me especifica como la ruta a conectar rutaO
como se podrá colocar una variable dentro de ese código?
Saludos.
Sin saber como son las tablas, sus nombres, si los campos son dieferentes, etc., si tengo una serie de tablas, no te fijes en los nombres ya que uso la base Neptuno para no tener que estar creando tablas, por eso le pongo nombres de países
Al no saber si las tablas están cambiando de nombre constantemente, hago una consulta de unión con ellas
Con lo que me quedaría
Luego en un formulario cualquiera, aunque no sería necesario, pero se ve mejor. Voy paso a paso, luego si quieres los unes.
Como no sé la ruta que quieres usar le pongo que me cree el archivo en la misma carpeta que la base de datos. Al pulsar el botón de arriba y luego el de abajo
Y si lo abro
El código de los botones es
Private Sub Comando2_Click()
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(CurrentProject.Path & "\alex.xlsx", True)
End Sub
Private Sub Comando3_Click()
DoCmd.OutputTo acOutputQuery, "Enviar", "ExcelWorkbook(*.xlsx)", "c:\users\gonza\documents\ejemplos\alex.xlsx", False, "", , acExportQualityPrint
End SubAunque también podrías hacerlo como(el cuadro de texto se llama Escribir
Y
En este caso el código del botón de arriba sería
Private Sub Comando2_Click()
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(CurrentProject.Path & "\" & Me.Escribir & ".xlsx", True)
End SubComo ves, no hace falta tanto código
