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

404 - Exportar recordset a Word

<Volver> - Anterior - Siguiente

Rutina que recorre un recordset de Ado, y exporta los datos a una tabla de Word

Para el ejemplo se necesita agregar los siguientes controles y referencias al proyecto :

La referencia a Microsoft Word
La referencia a Ado
Un CommandButton
Un ProgressBar

Por último a la Subrutina que exporta , pasarle como parámetro :

La ruta y nombre de la base de datos
la cadena Sql
y la ruta donde guardar y crear el archivo .doc con los datos exportados

por ejemplo :

Call Exportar("c:\datos.doc", _ "select * Form Tabla", _ "c:\base.mdb")

código fuente en el form

Option Explicit Private Sub Command1_Click() Call Exportar("c:\datos.doc", _ "select * Form Tabla", _ "c:\base.mdb") End Sub Private Sub Exportar(PathDesino As String, _ Sql As String, _ PathBd As String) On Error GoTo ErrSub Dim Word As New Word.Application Dim Doc As Word.Document Dim Tabla As Word.Table Dim f As ADODB.Field, Col As Integer Dim i As Integer, dato As Variant ' si la bd está abierta .. la cierra If cnn.State = adStateOpen Then cnn.Close End If ' abre la conexión cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _ "Source=" & txtDb.Text ' Abre el recordset With rs .CursorLocation = adUseClient .Open Sql, cnn, adOpenStatic, adLockReadOnly End With ' progressbar With ProgressBar1 .Max = rs.RecordCount .Value = 0 End With Screen.MousePointer = vbHourglass ' agrega la tabla al docucumento, las filas y columnas Set Doc = Word.Documents.Add Set Tabla = Doc.Tables.Add(Word.Selection.Range, _ rs.RecordCount + 1, _ rs.Fields.Count) 'agrega los Campos Col = 1 For Each f In rs.Fields Tabla.Cell(1, Col).Range.Font.Bold = True dato = f.Name Tabla.Cell(1, Col).Range.Text = dato Col = Col + 1 Next ' los Datos rs.MoveFirst For i = 1 To rs.RecordCount ProgressBar1.Value = i Col = 1 For Each f In rs.Fields dato = rs.Fields(f.Name) Tabla.Cell(i + 1, Col).Range.Text = dato Col = Col + 1 Next rs.MoveNext ' siguiente Next ' fin ProgressBar1.Value = 0 Screen.MousePointer = vbNormal MsgBox "Listo", vbInformation ' guarda el documento y lo cierra Doc.SaveAs PathDesino Set Tabla = Nothing Set Doc = Nothing Word.Quit Set Word = Nothing ' cierra el recordset y la bd rs.Close Set rs = Nothing cnn.Close Set cnn = Nothing 'Rutina de Error '''''''''''''''''''' Exit Sub ErrSub: ' por si el dato es un Null If Err.Number = 94 Then Err.Clear dato = vbNullString Resume Next Else MsgBox Err.Description Screen.MousePointer = vbNormal End If End Sub Private Sub Form_Load() Command1.Caption = "exportar" End Sub

Recursos visual basic 6.0 - Enlaces relacionados

Exportar recordset a Excel

Buscar en Recursos vb