Exportar datos de Access a Excel mediante código VBA.
Es que tengo el siguiente código que funciona bien pero hay un problema. Es que quiero exportar 2 tablas de access pero en excel quiero que cree 2 hojas para exportar las 2 tablas por separadas, he intentando pero no lo he logrado de momento me exporta todo en una sola hoja.
Call BD_Principal
Set Rg = New ADODB.Recordset
Rg.Open "SELECT ID_REGISTRO,FECHA_ENVIO,USUARIO_CREADOR,ID_CLIENTE,ID_ORDEN_INTERACCION,TIPO_VENTA,TIPO_ALTA,PRODUCTO_CARACTERISTICA,OFERTA_ASOCIADA FROM TB_Principal ORDER BY FECHA_ENVIO ASC", miConexion, adOpenKeyset, adLockOptimistic, adCmdText
Call BD_Principal
Set Ra = New ADODB.Recordset
Ra.Open "SELECT ID_REGISTRO,FECHA_ENVIO,USUARIO_CREADOR,ID_CLIENTE,ID_ORDEN_INTERACCION,TIPO_VENTA,TIPO_ALTA,PRODUCTO_CARACTERISTICA,OFERTA_ASOCIADA,USUARIO_GESTOR FROM TB_Gestionando ORDER BY FECHA_ENVIO ASC", miConexion, adOpenKeyset, adLockOptimistic, adCmdText
NombreHoja = "Ventas en espera"
NombreHoja2 = "Ventas en gestión"
Set APIExcel = CreateObject("Excel.Application")
Set AddLibro = APIExcel.Workbooks.Add
APIExcel.Visible = False
Set AddHoja = AddLibro.Worksheets(1)
If Len(NombreHoja) > 0 Then AddHoja.Name = Left(NombreHoja, 30)
columnas = Rg.Fields.Count
For I = 0 To columnas - 1
APIExcel.Cells(1, I + 1) = Rg.Fields(I).Name
Next I
Rg.MoveFirst
AddHoja.Range("A2").CopyFromRecordset Rg
Set AddHoja1 = AddLibro.Worksheets(1)
If Len(NombreHoja2) > 0 Then AddHoja1.Name = Left(NombreHoja2, 30)
columnas = Ra.Fields.Count
For I = 0 To columnas - 1
APIExcel.Cells(1, I + 1) = Ra.Fields(I).Name
Next I
Ra.MoveFirst
AddHoja1.Range("A2").CopyFromRecordset Ra
With APIExcel.ActiveSheet.Cells
.Select
.EntireColumn("A:H").AutoFit
.Range("A1").Select
End With
Rg.Close
Set Rg = Nothing
Ra.Close
Set Ra = Nothing
miConexion.Close
Base_Datos = MsgBox("La expotación de ventas ha finalizado con éxito, desea abrir el contenido exportado?", vbOKCancel, "Exportar ventas")
If Base_Datos = vbOK Then
APIExcel.Visible = True
End If
1 Respuesta
El código te exporta en una sola hoja porque así se lo indicas tu, al poner
Set AddHoja = AddLibro.Worksheets(1)
y
Set AddHoja1 = AddLibro.Worksheets(1)
Si cambias esta última linea por:
Set AddHoja1 = AddLibro.Worksheets(2)
Ya te crea y exportará a dos hojas distintas del mismo libro.
Un saludo.
Una cosa que veo no termina de funcionar en tu código es que los nombres de los campos te los pone solo en la primera hoja, con lo que te machaca los del primer recordset. Eso lo solucionas fácilmente así, añadiendo lo que está en negrita en el segundo bucle For... Next:
For i = 0 To columnas - 1
APIExcel.Sheets(2).Cells(1, i + 1) = Ra.Fields(i).Name
Next i
Buenas noches.
He realizado el siguiente código, pero no funciona solo me crea una tabla y es "Ventas en gestión" y solo exporta el Recordset Rs.
Call BD_Principal
Set Rg = New ADODB.Recordset
Rg.Open "SELECT * FROM TB_Principal WHERE FECHA_ENVIO BETWEEN #" & TextBox84.Text & "# AND #" & Label411.Caption & "# ORDER BY FECHA_ENVIO ASC", miConexion, adOpenKeyset, adLockOptimistic, adCmdText
Call BD_Principal
Set Rs = New ADODB.Recordset
Rs.Open "SELECT * FROM TB_Gestionando WHERE FECHA_ENVIO BETWEEN #" & TextBox84.Text & "# AND #" & Label411.Caption & "# ORDER BY FECHA_ENVIO ASC", miConexion, adOpenKeyset, adLockOptimistic, adCmdText
Hoja_1 = "Ventas en espera"
Hoja_2 = "Ventas en gestión"
Set APIExcel = CreateObject("Excel.Application")
Set AddLibro = APIExcel.Workbooks.Add
APIExcel.Visible = False
Set AddHoja = AddLibro.Worksheets(1)
If Len(Hoja_1) > 0 Then AddHoja.Name = Left(Hoja_1, 30)
columnas = Rg.Fields.Count
For I = 0 To columnas - 1
APIExcel.Sheets(1).Cells(1, I + 1) = Rg.Fields(I).Name
Next I
On Error Resume Next
Rg.MoveFirst
On Error Resume Next
AddHoja.Range("A2").CopyFromRecordset Rg
Set AddHoja2 = AddLibro.Worksheets(3)
If Len(Hoja_2) > 0 Then AddHoja.Name = Left(Hoja_2, 30)
columnas = Rs.Fields.Count
For T = 0 To columnas - 1
APIExcel.Sheets(3).Cells(1, T + 1) = Rs.Fields(T).Name
Next T
Rs.MoveFirst
AddHoja2.Range("A2").CopyFromRecordset Rs
'With APIExcel.ActiveSheet.Cells
'.Select
'.EntireColumn("A:G").AutoFit
'.Range("A1").Select
'End With
Rg.Close
Set Rg = Nothing
miConexion.Close
Set AddHoja2 = AddLibro.Worksheets(3)
If Len(Hoja_2) > 0 Then AddHoja.Name = Left(Hoja_2, 30)
columnas = Rs.Fields.Count
For T = 0 To columnas - 1
APIExcel.Sheets(3).Cells(1, T + 1) = Rs.Fields(T).Name
Next T
Rs.MoveFirst
AddHoja2.Range("A2").CopyFromRecordset Rs
En la ultima esta Worksheets (3) pero en realidad lo he probado con 2, solo que se me quedo allí haciendo algunas pruebas!
He probado tu código en una de mis BDs, y tras adaptarlo lo mínimo para que funcione y añadirle al final para que me muestre el Excel, a mi si me exporta las dos tablas correctamente (en la hoja 1 y en la 3). El único "error" que veo es que le dices que los nombres que les quieres dar a las hojas te los ponga siempre en la primera.
Te adjunto el archivo con mis pruebas para que veas que sí funciona: http://www.filebig.net/files/iaLCiaGnex
Mira los comentarios en el código
Un saludo.
