Combinar correspondencia Word y Access
Publicado por JCB (1 intervención) el 03/10/2017 16:05:05
Hola a todos.
Quiero que un procedimiento de Visual Basic de Access abra un archivo de Word, sustituya dos palabras concretas de la primera línea por dos campos de una consulta de la base de datos de Access, y luego combine la consulta de Access con el archivo Word.
En concreto, quiero sustituir las palabras "quien" y "donde" por los campos de la consulta "Nombre" y "Ciudad" de la consulta "personas", para luego combinar el Word completo con todos los registros de la consulta "personas".
He intentado varias cosas, pero estoy haciendo algo mal, pues el Access se bloquea después de abrir el Word y no sigue haciendo nada.
El código que estoy usando es:
Agradeceré mucho alguna pista para arreglarlo.
Muchas gracias por adelantado.
Quiero que un procedimiento de Visual Basic de Access abra un archivo de Word, sustituya dos palabras concretas de la primera línea por dos campos de una consulta de la base de datos de Access, y luego combine la consulta de Access con el archivo Word.
En concreto, quiero sustituir las palabras "quien" y "donde" por los campos de la consulta "Nombre" y "Ciudad" de la consulta "personas", para luego combinar el Word completo con todos los registros de la consulta "personas".
He intentado varias cosas, pero estoy haciendo algo mal, pues el Access se bloquea después de abrir el Word y no sigue haciendo nada.
El código que estoy usando es:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Private Sub Corresp_Click()
On Error GoTo Err_Corresp_Click
Dim WRD, WD, WDS, vent As Object
Dim fic As String
Set vent = Application.FileDialog(3)
vent.Title = "ARCHIVO BUSCADO"
vent.Filters.Clear
vent.Filters.Add "Archivos de Word", "*.docx; *.doc"
vent.FilterIndex = 1
If vent.Show = True Then
fic = vent.SelectedItems(1)
Else
MsgBox "NO EXISTE NINGÚN ARCHIVO PARA COMBINAR"
GoTo Exit_Corresp_Click
End If
Set WRD = CreateObject("Word.Application")
Set WD = WRD.Documents.Open(fic)
WD.Activate
Set WDS = WD.Range(Start:=0, End:=WD.Lines(1).Range.End)
With WDS.Find
.ClearFormatting
.Execute FindText:="quien", ReplaceWith:="Nombre", Replace:=wdReplaceOne
.Execute FindText:="donde", ReplaceWith:="Ciudad", Replace:=wdReplaceOne
End With
With WD.MailMerge
.OpenDataSource Name:=CurrentDb.Name, ConfirmConversions:=False, AddToRecentFiles:=False, Connection:="TABLE personas"
.Fields.Add Range:=WD.Range, Type:=wdFieldDatabase, Name:="Nombre"
.Fields.Add Range:=WD.Range, Type:=wdFieldDatabase, Name:="Ciudad"
.Destination = wdSendToNewDocument
.Execute Pause:=False
End With
WRD.Documents.Close fic, SaveChanges:=False
WRD.Application.Quit
Exit_Corresp_Click:
Exit Sub
Err_Corresp_Click:
MsgBox Err.Description
Resume Exit_Corresp_Click
End Sub
Agradeceré mucho alguna pista para arreglarlo.
Muchas gracias por adelantado.
Valora esta pregunta
0