Sección de códigos, trucos y ejemplos para visual basic

Clic para descargar Velneo Open source Software - Plataforma para el desarrollo de aplicaciones sobre base de datos

466 - vba - Macro para importar query desde Access a Excel

Macro de ejemplo que importa una query desde una base de datos usando Ado a una hoja de Microsoft excel

Crear un nuevo libro. Añadir en un módulo el siguiente código fuente y la referencia a Ado . También especificar los siguientes datos a la subrutina "Query_Access_to_excel"

la ruta de la base de datos
el nombre de la Sheet
la query

Código fuente

Option Explicit ' Incluir la referencia de ADO '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub Main() Dim bd As String bd = "C:\Archivos de programa\Microsoft Visual Studio\VB98\biblio.mdb" Call Query_Access_to_excel(bd, "Sheet1", "Select * from Authors") End Sub Sub Query_Access_to_excel( _ sBd As String, _ sHoja As String, _ sSQL As String) Dim rs As ADODB.Recordset ' variable recordset Dim sConnection As String ' cadena de con . Dim Range_Destino As Range ' variable de tipo Range Dim i As Integer ' bloquear la actualización de pantalla para acelerar el proceso Application.ScreenUpdating = False Set Range_Destino = ActiveWorkbook.Sheets(sHoja).Cells(1, 1) ' asigna la Cadena de conexión sConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source= " & sBd & ";" ' crear un nuevo recordset Set rs = New ADODB.Recordset ' trae los registros rs.Open sSQL, _ sConnection, _ adOpenForwardOnly, _ adLockReadOnly '.. si hay reg .. If Not rs.EOF Then ' Nombre de los encabezados For i = 0 To rs.Fields.Count - 1 Range_Destino.Offset(0, i).Value = rs.Fields(i).Name Next ' copia los registros Range_Destino.Offset(1, 0).CopyFromRecordset rs DoEvents ' listo MsgBox "Importación Completa", vbInformation Else ' no hay datos MsgBox "No hay registros activos para importar", vbInformation End If ' liberar el recordset If Not rs Is Nothing Then If rs.State = adStateOpen Then rs.Close ' close End If Set rs = Nothing ' elimina la referencia End If If Not Range_Destino Is Nothing Then Set Range_Destino = Nothing End If End Sub

Recursos visual basic 6 - Enlaces relacionados

Buscar en Recursos vb