Abrir word y combinar campos access en visual

¿Qué código tengo que poner para que al pulsar un botón se me abra el word y me combine los campos automáticamente con los campos de una tabla?, hasta ahora he conseguido abrir el documento word, pero con los campos sin combinar, es decir, se me abre el word y me aparece:
<<NOM>>
<<DOMI1>>
el codigo que he utilizado es este:
Dim Documento As New Word.Application
    With Documento
         .Application.Documents.Open camino & "\cartas.doc"
         .Application.Visible = True
    End With
    Set Documento = Nothing

1 Respuesta

Respuesta
1
Pués asi como entendi, lo que quieres es pasar datos a word, am pués yo utilizo una función la cuál recibe tres valores:
1. Nombre del documento de word
2. String SQL
3. Nombre de la base de datos
Call Exportar("Factura.doc", "select * from Compra","C:\bd.mdb")
Y la función quedaría así:
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 conexion.State = adStateOpen Then
       conexion.Close
    End If
    ' abre la conexión
    conexion.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
             "Source=" & "c:\bd.mdb"
    ' Abre el recordset
    With Recordset
        .CursorLocation = adUseClient
        .Open sql, conexion, adOpenStatic, adLockReadOnly
    End With
    Screen.MousePointer = vbHourglass
    'Agrega la tabla al docucumento, las filas y columnas
    Set Doc = Word.Documents.Add
    Word.Selection.Paragraphs.Alignment = wdAlignParagraphRight
    Word.Selection.TypeText Date
    Word.Selection.TypeText vbCrLf 'Salto a otra línea
    Word.Selection.TypeText vbCrLf 'Salto a otra línea
    Word.Selection.Paragraphs.Alignment = wdAlignParagraphCenter
    Word.Selection.TypeText "Compras"
    Word.Selection.Paragraphs.Alignment = wdAlignParagraphCenter
    Set Tabla = Doc.Tables.Add(Word.Selection.Range, _
                               Recordset.RecordCount + 1, _
                               Recordset.Fields.Count)
    Tabla.Cell(1, 1).SetWidth 50, wdAdjustFirstColumn
    Tabla.Cell(1, 1).Range.Text = "Folio"
    Tabla.Cell(1, 2).SetWidth 80, wdAdjustFirstColumn
    Tabla.Cell(1, 2).Range.Text = "Codigo"
    Tabla.Cell(1, 3).SetWidth 80, wdAdjustFirstColumn
    Tabla.Cell(1, 3).Range.Text = "Fecha"
    'Los Datos
    Recordset.MoveFirst
    For i = 1 To Recordset.RecordCount
        col = 1
        For Each f In Recordset.Fields
            dato = Recordset.Fields(f.Name)
            Tabla.Cell(i + 1, col).Range.Text = dato
            col = col + 1
        Next
        Recordset.MoveNext 'Siguiente
    Next
    'Fin
    Screen.MousePointer = vbNormal
    MsgBox "Informe de Compras Listo.", vbInformation, "Compras"
    'Guarda el documento y lo cierra
    Doc.SaveAs PathDesino
    Set Tabla = Nothing
    Set Doc = Nothing
    Word.Quit
    Set Word = Nothing
    Dim mipath As String
    mipath = App.Path
    Dim lValDev As Long
    lValDev = ShellExecute(Me.hWnd, "Open", mipath & "\Factura.doc", "", "", 1)
    Exit Sub
'Rutina de Error
''''''''''''''''''''
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 
En la parte de declaraciones escribirías lo siguiente para poder llamar a word:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Espero que te sirva de ayuda esta información que te doy, si tienes algún otro problema no dudes en preguntar, y ya sabes el mecanismo de Terminar y Puntuar las respuestas.
Gracias por contestar con tanta rapidez, me sale un error en la linea:
Dim f As ADODB.Field
me dice que no esta definido por el usuario, que tengo que añadir en referencias?, donde pones "compras", "folios", etc, son campos de la tabla verdad?
Muchas Gracias.
Si, en la parte izquierda vienen los componentes y también puedes agregarlos usando Ctrl + T y ahí agregarías lo que viene siendo un Control para la conexión ADO y un Control Datagrid que viene un poco más abajo del control Ado, también te vas a la ventana de Referencias y le agregas una que dice "Microsoft Word11.0 Object Library", dependiendo del Office que tengas, esta ventana sale en el menu Proyecto>>Referencias. Y si, los campos "Compras, Folio, Fecha" son los que tengo en mi tabla, solo seria adecuarlos a la tuya.
Ahora me dice en la linea:
If conexion.State = adStateOpen Then
Conexión es una variable no definida
¿Dónde la tengo que declarar y de que tipo es?
Por si te sale error también en el recordset te dejo como se declaran las variables.
Dim conexion As ADODB.Conection
Dim recordset As ADODB.Recordset
Hola buenos días, ahora me sale error en la declaración de la variable "conexion" que dice que no esta definida por el usuario, ¿qué componente me falta? ¿Cuál es el adodb?. Muchas Gracias.
Buenos dias de nuevo, he conseguido solventar el problema anterior, y ahora cuando llega a la linea "If conexion.State = adStateOpen Then" me dice que "conexion.state" la variable  no esta establecida. Muchas Gracias.
Pues la conexión es la variable que declaras como te lo puse en el comentario anterior, si quieres pega aquí tu código y veo que te falta.
Perdon por la equivocación: Dim conexion As ADODB.Connection
Private Sub Exportar(PathDesino As String, sql As String, PathBd As String)
On Error GoTo ErrSub
    Dim conexion As Adodb.Connection
    Dim recordset As Adodb.recordset
    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 conexion.State = adStateOpen Then
       conexion.Close
    End If
    ' abre la conexión
    conexion.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
             "Source=" & camino
    ' Abre el recordset
    With recordset
        .CursorLocation = adUseClient
        .Open sql, conexion, adOpenStatic, adLockReadOnly
    End With
    Screen.MousePointer = vbHourglass
    'Agrega la tabla al docucumento, las filas y columnas
    Set Doc = Word.Documents.Add
    Word.Selection.Paragraphs.Alignment = wdAlignParagraphRight
    Word.Selection.TypeText Date
    Word.Selection.TypeText vbCrLf 'Salto a otra línea
    Word.Selection.TypeText vbCrLf 'Salto a otra línea
    Word.Selection.Paragraphs.Alignment = wdAlignParagraphCenter
    Word.Selection.TypeText "Compras"
    Word.Selection.Paragraphs.Alignment = wdAlignParagraphCenter
    Set Tabla = Doc.Tables.Add(Word.Selection.Range, _
                               recordset.RecordCount + 1, _
                               recordset.Fields.Count)
    Tabla.Cell(1, 1).SetWidth 50, wdAdjustFirstColumn
    Tabla.Cell(1, 1).Range.Text = "Folio"
    Tabla.Cell(1, 2).SetWidth 80, wdAdjustFirstColumn
    Tabla.Cell(1, 2).Range.Text = "Codigo"
    Tabla.Cell(1, 3).SetWidth 80, wdAdjustFirstColumn
    Tabla.Cell(1, 3).Range.Text = "Fecha"
    'Los Datos
    recordset.MoveFirst
    For i = 1 To recordset.RecordCount
        col = 1
        For Each f In recordset.Fields
            dato = recordset.Fields(f.Name)
            Tabla.Cell(i + 1, col).Range.Text = dato
            col = col + 1
        Next
        recordset.MoveNext 'Siguiente
    Next
    'Fin
    Screen.MousePointer = vbNormal
    MsgBox "Informe de Compras Listo.", vbInformation, "Compras"
    'Guarda el documento y lo cierra
    Doc.SaveAs PathDesino
    Set Tabla = Nothing
    Set Doc = Nothing
    Word.Quit
    Set Word = Nothing
    Dim mipath As String
    mipath = App.Path
    Dim lValDev As Long
    lValDev = ShellExecute(Me.hWnd, "Open", mipath & "\cartas.doc", "", "", 1)
    Exit Sub
'Rutina de Error
''''''''''''''''''''
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
En la linea "If conexion.State = adStateOpen Then" me dice que "conexion.state" la variable  no esta establecida y sin embargo la tengo declarada al principio de la funcion como tu me comentaste.
Acá esta un ejemplo con el mismo código, ya lo tenia guardado, pero no lo encontraba, espero te sirva mi respuesta y la califiques bien. Si tienes algún otra duda aquí estoy para apoyarte en lo que quieras.
Saludos..!
Lic. Juan A. Carmona Scott
Ejemplo: Word
Hola de nuevo, ya casi lo tengo, ahora cuando llega al bucle de los datos, tengo un problema, y es que algunos campos en mi base de datos están vacíos, entonces me da error de uso no válido de null:
For Each f In recordset.Fields
            dato = recordset.Fields(f.Name)
            Tabla.Cell(i + 1, col).Range.Text = dato
            col = col + 1
 Next
¿Cómo podría darle un valor por defecto en caso de que la variable "dato" sea nulo?
Muchas Gracias.
Otra cosa, que me he fijado en el ejemplo que me has enviado, es que los registros te los escribe todos en el mismo folio, ¿cómo podría hacer para que cada registro me los imprimiera en un folido diferente? Muchas Gracias.
Amm pues para pasar ese error desapercibido y seguir imprimiendo tendrías que decirle a visual basic que se pase a otra linea si encuentra un error, quedaría algo así:
ErrSub:
    ' por si el dato es un Null
    If Err.Number = 94 Then
       Err.Clear
       dato = vbNullString
       Resume Next   '''''Esta parte hace que se brinque el error y continue
    Else
       MsgBox Err.Description
       Screen.MousePointer = vbNormal
       Resume Next   '''''Aqui deberias de agregar otro para evitar los errores de carga
    End If
Y lo de los Folios tu puedes manipular lo que desses que se te pase a Word usando diferentes instrucciones SQL en donde esta el string de éste.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas