Private Sub cmdCreateLetter_Click()
Dim dbLocal As Database
Dim snpReplaceCodes As Recordset
Dim strCurrAppDir As String
Dim strFinalDoc As String
Dim varReplaceWith As Variant
Dim docWord As Word.Document
On Error GoTo Error_cmdCreateLetter_Click
Set dbLocal = CurrentDb()
strCurrAppDir = Left$(dbLocal.Name, InStrRev(dbLocal.Name, "\"))
strFinalDoc = strCurrAppDir & "DemoTest.rtf"
On Error GoTo Error_cmdCreateLetter_Click
Set appWord = New Word.Application
Set docWord = appWord.Documents.Add(strFinalDoc)
appWord.Visible = True
'abro ahora la tabla de las sustituciones
Set snpReplaceCodes = dbLocal.OpenRecordset("reemplazacodigos", _
dbOpenSnapshot)
Do While Not snpReplaceCodes.EOF
varReplaceWith = Eval(snpReplaceCodes!ReplaceWithFieldName)
varReplaceWith = IIf(IsNull(varReplaceWith), " ",
CStr(varReplaceWith))
With docWord.Content.Find
If snpReplaceCodes!CodeToReplace = "{MOVIETITLE}" Then
With .Replacement
.ClearFormatting
.Font.Bold = True
.Font.Italic = True
End With
End If
.Execute FindText:=snpReplaceCodes!CodeToReplace, _
ReplaceWith:=varReplaceWith, Format:=True, _
Replace:=wdReplaceAll
End With
snpReplaceCodes.MoveNext
Loop
snpReplaceCodes.Close
Exit Sub
Error_cmdCreateLetter_Click:
Beep
MsgBox "Ha ocurrido el error:" & vbCrLf & _
Err.Description, vbCritical, "OLE Error!"
Exit Sub
End Sub
               (
geocities.com/es/ensolva/Descargas)                   (
geocities.com/es/ensolva)                   (
geocities.com/es)