Visual Basic para Aplicaciones - Combinar correspondencia Word y Access

Life is soft - evento anual de software empresarial
 
Vista:

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:

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
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder