
21/07/2004, 12:01
|
| | Fecha de Ingreso: abril-2004 Ubicación: Managua
Mensajes: 150
Antigüedad: 20 años, 10 meses Puntos: 0 | |
Te envio este ejemplo de un trabajo que me toco similar una ves
Text1 es la ruta con el nombre de la base de datos donde estan los datos
text2 es la ryta con el nombre del archivo de excel donde voy a guardar los datos.
Private Sub exportar_Click()
If Text1.Text = "" Or Text2.Text = "" Then
Else
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim archiexcel
cn.Provider = "microsoft.jet.oledb.4.0"
cn.ConnectionString = Text1.Text
cn.Open
rs.Open "select * from Contactos", cn, adOpenKeyset, adLockOptimistic
rs.MoveFirst
ExportaFacturaExcel rs, Text2.Text
End If
End Sub
Public Sub ExportaFacturaExcel(ByRef rs As ADODB.Recordset, NombreDocumento As String)
On Error GoTo err
'Creamos los objetos que necesitaremos para gestionar el documento
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim exportFileName As String
Dim i As Long
Dim j As Long
Dim numFilas As Long
'Inicializamos las variables que se encargaran de gestionar las filas
'y columnas del fichero Excel
i = 1
j = 1
numFilas = 0
'exportFileName = "C:\Archivos de programa\0sistemas\csvbase\prueba\" & NombreDocumento & ".xls"
'exportFileName = "C:\Archivos de programa\0sistemas\csvbase\prueba\" & NombreDocumento & ".xls"
exportFileName = NombreDocumento
' Asignamos las referencias a los objetos para inicializarlos
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
' Asignamos los valores a la hoja de calculo para poder manejarlos
xlApp.DisplayAlerts = False
'Ahora tenemos que movernos por el fichero para cargar los datos que nos
'han pasado por referencia.
'En primer lugar entraremos en un bucle que nos permite
'obtener los nombres de los campos que nos devuelve la sentencia
'sql, y de esta forma establecemos las cabeceras del fichero Excel.
While (numFilas < rs.Fields.Count)
xlSheet.Cells(i, j) = rs.Fields(numFilas).Name
j = j + 1
numFilas = numFilas + 1
Wend
'Incrementamos el contador de las filas, para saltar de fila
'y proceder a imprimir los datos del recordset
i = i + 1
While (Not rs.EOF)
j = 0
'Antes de hacer esto y fuera del bucle tenemos que generar las cabeceras.
'Pasaamos a cargar los datos del recordset en la hoja excel
While (j < numFilas)
xlSheet.Cells(i, j + 1).Value = rs(j)
j = j + 1
Wend
i = i + 1
rs.MoveNext
Wend
'Ahora procedemos a guardar la hoja de calculo
xlSheet.SaveAs exportFileName
' Cerramos el libro en el cual guardamos los resultados.
xlBook.Close
' Cerramos la aplicacion Excel
xlApp.Quit
' Release the objects.
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
'Dejamos que el sistema realize las operaciones necesarias para
'poder gestionar las facturas
'DoEvents
MsgBox "Fichero generado correctamente"
'Salimos del procedimiento
Exit Sub
'Control de errores
err:
'DEstruimos los objetos que hemos generado
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
'Generamos el log correspondiente y devolvemos un error
MsgBox "EL fichero no ha podido ser generado" & vbNewLine & "Compruebe que este no se encuentre abierto", vbInformation, err.Description
End Sub
Última edición por rsiles; 21/07/2004 a las 12:05 |