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

285 - Exportar un Recordset a html

Módulo de clase que permite exportar un recordset Ado a un archivo Html

El siguiente módulo permite generar un archivo Html con el contenido de un recordset. El módulo permite especificar las propiedades relacionadas al formato en el cual exportar, por ejemplo indicar la alineación de los textos, los colores de las fuentes, tamaño , tipo etc...

El método que exporta se llama Exportar_Recordset, y tiene cuatro parámetros:

Sub Exportar_Recordset_Html(Path_Html As String, _
                            rs As Recordset, _
                            TEXTO_ENCABEZADO As String, _
                            TEXTO_PIE As String)

End Sub

Path_Html: Ruta y nombre del archivo Html

Rs: El recordset

TEXTO_ENCABEZADO: Texto a mostrar en el título

TEXTO_PIE : Texto del pie de página

Nota: Para indicar los colores de las fuentes y demás, se debe establecer el valor de color en formato Long, por ejemplo para establecer en color azul para la fuentes de los encabezados de columna:

Clase.COLOR_FUENTE_ENCABEZADO = VbBlue

Formulario de ejemplo:

Colocar en un formulario un control ProgressBar, un CommandButton, y tres TextBox ( txt_sql, txt_titulo y txt_Pie).

También agregar la referencia a Ado ( Microsoft Activex Data Objects )

Nota: Al exportar, tener en cuanta que si se exportan muchos registros, puede demorar bastante

En el ejemplo, se exportan los primeros 500 registros de la tabla Authors de la base de datos Biblio que viene en la carpeta de instalación de visual basic

A continuación se lista el código del formulario, y al final el código del módulo de clase ( Class1)

Código fuente en el Form

 Option Explicit

'***************************************************************************
'*  Ejemplo para exportar un recordset ado a un archivo HTML _

'*  Controles: Un CommandButton, _
               Tres TextBox ( txt_SQL, txt_titulo y txt_Pie), _
               Un ProgressBar
               
'*  Referencias: Microsoft Activex xx Data Objects
    
'*  Nota: el archivo htm se genera en el App.path del proyecto
'***************************************************************************

'Variable con evento para el módulo ( el evento es para el progreso )
Private WithEvents oExportar As Class1

' Botón que exporta el Recordset
'***************************************************************************
Private Sub Command1_Click()
    
    
    Dim Conection_String As String
    Dim rs As Recordset
    Dim Path_Html As String
    
    'Nueva instancia del módulo
    Set oExportar = New Class1
    
    'Crea un recordset
    Set rs = New Recordset
    
    ' Indicar el path de la base de datos
    Conection_String = "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
             "Source=C:\Archivos de programa\Microsoft Visual Studio" & _
             "\VB98\biblio.mdb;Persist Security Info=False"
    
    
    rs.CursorLocation = adUseClient
    
    'Abre el recordset
    rs.Open txt_sql.Text, Conection_String, adOpenStatic, adLockReadOnly
    
    Dim Path As String
    
    'Path donde se generará el archivo HTML
    Path_Html = App.Path & "\" & App.EXEName & ".html"
    
    
    ' Propiedades de la exportación
    '*********************************
    
    With oExportar
        
        ' Alineación de los textos
        .ALIGN_ENCABEZADO = AlignLeft
        .ALIGN_FUENTE_CELDA = AlignLeft
        
        ' Nombre de las fuentes
        .FONT_NAME_CELDAS = "Verdana"
        .FONT_NAME_ENCABEZDO = "Verdana"
        
        .COLOR_BORDE_TABLA = 12632256
        
        .COLOR_FUENTE_CELDA = vbBlack
        .COLOR_FUENTE_ENCABEZADO = vbBlue
        
        'Tamaño de las fuentes
        .FONT_SIZE_CELDA = [2]
        .FONT_SIZE_ENCABEZDO = [3]
        .FONT_SIZE_TITULO = [4]
        .FONT_SIZE_PIE = [3]
        
        'Tamaño del borde la tabla ( 0 sin Borde )
        .SIZE_BORDE_TABLA = 10
        
        ' Exporta el recordset
        Call .Exportar_Recordset_Html(Path_Html, rs, txt_titulo, txt_Pie)
        
    End With
        
        'Elimina la referencia del módoulo y el recordset
        Set oExportar = Nothing
    
        If Not rs.State = adStateClosed Then
            rs.Close
        End If
        If Not rs Is Nothing Then
            Set rs = Nothing
        End If
End Sub



' Evento para mostrar el progreso de la exportación en el Progressbar
Private Sub oExportar_Progreso(Max_Record As Long, Value As Long)
    
    ProgressBar1.Max = Max_Record
    ProgressBar1.Value = Value

End Sub
 Private Sub Form_Unload(Cancel As Integer)
    If Not oExportar Is Nothing Then
       oExportar = Nothing
    End If
End Sub

Private Sub Form_Load()
    
    ' Caption de los controles
    Me.Caption = " Ejemplo - exportar recordset Ado a Html "
    txt_titulo = " Listado de ejemplo "
    txt_Pie = " Fin del listado "
    txt_sql = "SELECT top 500 * FROM Authors"
    Command1.Caption = " Exportar "
End Sub

Código fuente del módulo de clase ( Class1 )

Option Explicit

'***************************************************************************
'* Código del módulo de clase para exportar el Recordset ADO
'***************************************************************************

'******************************************
'Variables locales
'******************************************

' Colores de las fuentes
'******************************************

' Color de la fuente para las columnas
Private m_COLOR_FUENTE_ENCABEZADO As String
' Color de la fuente de los items
Private m_COLOR_FUENTE_CELDA As String
' Color de la fuente del título del listado
Private m_COLOR_FUENTE_TITULO As String

' Colores de bordes
'******************************************

'Indica el color del borde la tabla ( el valor _
SIZE_BORDE_TABLA debe ser mayor a 0 )
Private m_COLOR_BORDE_TABLA As String

' Colores de fondo
'******************************************

Private m_COLOR_FONDO_PAGINA As String
Private m_COLOR_FONDO_CELDA As String
Private m_COLOR_FONDO_ENCABEZADO As String
Private m_COLOR_FONDO_TABLA As String

' Tamaños de las fuentes ( Titulo y pie de la página )
'*****************************************************
Private m_FONT_SIZE_TITULO As String
Private m_FONT_SIZE_PIE As String

' Tamaños de las fuentes ( los items y encabezados de columnas )
'*****************************************************
Private m_FONT_SIZE_CELDA As String
Private m_FONT_SIZE_ENCABEZDO As String

' Nombre de fuente a usar para los registros y los campos
'*****************************************************
Private m_FONT_NAME_CELDAS As String 'Celdas
Private m_FONT_NAME_ENCABEZDO As String 'Columnas

'Alineación del texto de los items y de las columnas
'*****************************************************
Private m_ALIGN_ENCABEZADO As String
Private m_ALIGN_FUENTE_CELDA As String

'Tamaño para el borde de la tabla
'*****************************************************
Private m_SIZE_BORDE_TABLA As String

'Enumeraciones
'*****************************************************

Enum e_Align
AlignLeft = 0
AlignRight = 1
AlignCenter = 2
End Enum

Enum e_Size_Font
[0] = 0
[1] = 1
[2] = 2
[3] = 3
[4] = 4
[5] = 5
[6] = 6
[7] = 7
End Enum

' Eventos
'*****************************************************
Public Event Progreso(Max_Record As Long, Value As Long)

'***************************************************************************
'* Sub que exporta el Recordset a HTML
'***************************************************************************

Sub Exportar_Recordset_Html(Path_Html As String, _
rs As Recordset, _
TEXTO_ENCABEZADO As String, _
TEXTO_PIE As String)

On Local Error GoTo ErrSub

Dim codigo_Html As String
Dim Fila As Integer
Dim Columna As Integer
Dim fname As String
Dim f As Integer
Dim Item As ListItem

' Verifica que el recordset esté abierto
If rs.State = adStateClosed Then
MsgBox " El recordset no ha sido abierto "
Exit Sub
End If

Screen.MousePointer = vbHourglass

' inicio de la tabla, el color y el borde
codigo_Html = "<TABLE width=100% BORDER=" & m_SIZE_BORDE_TABLA & _
" Bordercolor=" & m_COLOR_BORDE_TABLA & " bgcolor=" & _
m_COLOR_FONDO_TABLA & ">" & vbCrLf

' crea los encabezados ( los campos )
codigo_Html = codigo_Html & "<TR bgcolor=" & _
m_COLOR_FONDO_ENCABEZADO & "> " & vbCrLf

'Recorre las columnas del recordset y los crea
For Columna = 0 To rs.Fields.Count - 1

codigo_Html = codigo_Html & " <TH><div align=" & _
m_ALIGN_ENCABEZADO & "><font size=" & _
m_FONT_SIZE_ENCABEZDO & " face=" & _
m_FONT_NAME_ENCABEZDO & _
" color=" & m_COLOR_FUENTE_ENCABEZADO & ">" & _
rs.Fields(Columna).Name & _
"</font></div></TH>" & vbCrLf

Next Columna

codigo_Html = codigo_Html & "</TR>" & vbCrLf

'Mueve el ercordset al primer registro
rs.MoveFirst

' Variable para el evento de progreso
Dim i As Long
Dim Rec_Count As Long

Rec_Count = rs.RecordCount

'recorre los registros del recordset
While Not rs.EOF

i = i + 1

'Etiqueta de apertura para crear el registro actual
codigo_Html = codigo_Html & "<TR bgcolor=" & _
m_COLOR_FONDO_CELDA & " > " & vbCrLf

' Recorre los campos
For Columna = 0 To rs.Fields.Count - 1

' Etiqueta de apertura, Establece las propiedades de la _
celda y el valor del registro actual

codigo_Html = codigo_Html & " <td><div align=" & _
m_ALIGN_FUENTE_CELDA & "><font color=" & _
m_COLOR_FUENTE_CELDA & " size=" & _
m_FONT_SIZE_CELDA & " face=" & _
m_FONT_NAME_CELDAS & ">" & _
rs.Fields(Columna) & _
"</font></div></td>" & vbCrLf

Next

rs.MoveNext
' Cierra la etiqueta HTML de la fila actual
codigo_Html = codigo_Html & "</TR>" & vbCrLf

'Muestra el progreso
RaiseEvent Progreso(Rec_Count, i)

Wend
' Cierra la etiqueta HTML de la Tabla
codigo_Html = codigo_Html & "</table>" & vbCrLf

'Agrega las etiquetas restantes, el pie de página _
y completa el código Html a generar

codigo_Html = "<HTML><HEAD></HEAD><BODY BGCOLOR=" _
& m_COLOR_FONDO_PAGINA & ">" & vbCrLf & _
"<p><font face=verdana size=" & _
m_FONT_SIZE_TITULO & " color=" & _
m_COLOR_FUENTE_TITULO & ">" & _
TEXTO_ENCABEZADO & _
"</font></p><HR>" & codigo_Html & _
"<HR><font face=verdana size=" & _
m_FONT_SIZE_PIE & " color=" & _
m_COLOR_FUENTE_TITULO & _
">" & TEXTO_PIE & "</font></BODY></HTML>"

'Abre y Crea el archivo Html
f = FreeFile
Open Path_Html For Output As f

'Escribe los datos
Print #f, codigo_Html

'Cierra
Close

Screen.MousePointer = vbNormal

'fin
MsgBox " Archivo Html generado en: " & vbCrLf & Path_Html, vbInformation

RaiseEvent Progreso(Rec_Count, 0)

Exit Sub

'Error
ErrSub:

MsgBox Err.Description, vbCritical
RaiseEvent Progreso(0, 0)
Screen.MousePointer = vbNormal
End Sub

'***************************************************************************
'* Función que convierte el valor de color en formato _
Long, a formato Hexadecimal web
'***************************************************************************

Private Function Obtener_Color_Hexadecimal(ByVal Color As Long) As String
Dim Azul As Byte, Verde As Byte, Rojo As Byte
Dim sRojo As String, sVerde As String, sAzul As String

'Descompone el color
Azul = (Color And 16711680) / 65536
Verde = (Color And 65280) / 256
Rojo = Color And 255

If Len(Hex$(Azul)) = 1 Then
sAzul = "0" & Hex$(Azul)
Else
sAzul = Hex$(Azul)
End If

If Len(Hex$(Verde)) = 1 Then
sVerde = "0" & Hex$(Verde)
Else
sVerde = Hex$(Verde)
End If

If Len(Hex$(Rojo)) = 1 Then
sRojo = "0" & Hex$(Rojo)
Else
sRojo = Hex$(Rojo)
End If

'Retorna el valor
Obtener_Color_Hexadecimal = "#" & sRojo & sVerde & sAzul

End Function

'***************************************************************************
'* Propiedades
'***************************************************************************

Property Let COLOR_FUENTE_ENCABEZADO(Valor As Long)
m_COLOR_FUENTE_ENCABEZADO = Obtener_Color_Hexadecimal(Valor)
End Property
Property Let COLOR_FUENTE_CELDA(Valor As Long)
m_COLOR_FUENTE_CELDA = Obtener_Color_Hexadecimal(Valor)
End Property
Property Let COLOR_FUENTE_TITULO(Valor As Long)
m_COLOR_FUENTE_TITULO = Obtener_Color_Hexadecimal(Valor)
End Property
Property Let COLOR_BORDE_TABLA(Valor As Long)
m_COLOR_BORDE_TABLA = Obtener_Color_Hexadecimal(Valor)
End Property
Property Let COLOR_FONDO_PAGINA(Valor As Long)
m_COLOR_FONDO_PAGINA = Obtener_Color_Hexadecimal(Valor)
End Property
Property Let COLOR_FONDO_CELDA(Valor As Long)
m_COLOR_FONDO_CELDA = Obtener_Color_Hexadecimal(Valor)
End Property
Property Let COLOR_FONDO_ENCABEZADO(Valor As Long)
m_COLOR_FONDO_ENCABEZADO = Obtener_Color_Hexadecimal(Valor)
End Property
Property Let COLOR_FONDO_TABLA(Valor As Long)
m_COLOR_FONDO_TABLA = Obtener_Color_Hexadecimal(Valor)
End Property
Property Let FONT_SIZE_TITULO(Valor As e_Size_Font)
m_FONT_SIZE_TITULO = CStr(Valor)
End Property
Property Let FONT_SIZE_PIE(Valor As e_Size_Font)
m_FONT_SIZE_PIE = CStr(Valor)
End Property
Property Let FONT_SIZE_CELDA(Valor As e_Size_Font)
m_FONT_SIZE_CELDA = CStr(Valor)
End Property
Property Let FONT_SIZE_ENCABEZDO(Valor As e_Size_Font)
m_FONT_SIZE_ENCABEZDO = CStr(Valor)
End Property
Property Let FONT_NAME_CELDAS(Valor As String)
m_FONT_NAME_CELDAS = Valor
End Property
Property Let FONT_NAME_ENCABEZDO(Valor As String)
m_FONT_NAME_ENCABEZDO = Valor
End Property
Property Let ALIGN_ENCABEZADO(Valor As e_Align)

Select Case Valor
Case 0: m_ALIGN_ENCABEZADO = "Left"
Case 1: m_ALIGN_ENCABEZADO = "Right"
Case 2: m_ALIGN_ENCABEZADO = "Center"
End Select

End Property

Property Let ALIGN_FUENTE_CELDA(Valor As e_Align)
Select Case Valor
Case 0: m_ALIGN_FUENTE_CELDA = "Left"
Case 1: m_ALIGN_FUENTE_CELDA = "Right"
Case 2: m_ALIGN_FUENTE_CELDA = "Center"
End Select
End Property
Property Let SIZE_BORDE_TABLA(Valor As Long)
m_SIZE_BORDE_TABLA = CStr(Valor)
End Property

Private Sub Class_Initialize()
' Valores por defecto de las propiedades al iniciar la instancia
'****************************************************************

m_COLOR_FUENTE_ENCABEZADO = "#666666"
m_COLOR_FUENTE_CELDA = "#999999"
m_COLOR_FUENTE_TITULO = "#FFFFFF"
m_COLOR_BORDE_TABLA = "#999999"
m_COLOR_FONDO_PAGINA = "#CCCCCC"
m_COLOR_FONDO_CELDA = "#FFFFFF"
m_COLOR_FONDO_ENCABEZADO = "#CCCCCC"
m_COLOR_FONDO_TABLA = "#FFFFFF"
m_FONT_SIZE_TITULO = "4"
m_FONT_SIZE_PIE = "2"
m_FONT_SIZE_CELDA = "2"
m_FONT_SIZE_ENCABEZDO = "2"
m_FONT_NAME_CELDAS = "Verdana"
m_FONT_NAME_ENCABEZDO = "Arial"
m_ALIGN_ENCABEZADO = "left"
m_ALIGN_FUENTE_CELDA = "left"
m_SIZE_BORDE_TABLA = "0"

End Sub

Recursos vb 6.0 - Enlaces relacionados

Buscar en Recursos vb