Access - combinar Access con Word

Private Sub Comando309_Click()

On Error GoTo ManejadorError

Dim appWord As Word.Application

Dim docs As Word.Documents

Dim doc As Word.Document

Dim strRutaPlantilla As String

Dim strTestPlantilla As String

Dim strNuevoDocumento As String

' Ruta completa de la plantilla de Word

strRutaPlantilla = "C:\Blas\Part Acc 2009\Informe accidente.dot"

' Ruta y nombre del nuevo documento

strNuevoDocumento = "C:\Blas\Part Acc 2009\Atestados\" & Me.IDRefNum & ".doc"

'Sí existe el archivo lo abrimos y nos salimos,

' sino existe lo creamos

strTestPlantilla = Nz(Dir(strNuevoDocumento))

If strTestPlantilla <> "" Then

Application.FollowHyperlink strNuevoDocumento

Exit Sub

End If

Set appWord = CreateObject(Class:="Word.Application")

Set docs = appWord.Documents

Set doc = docs.Add(strRutaPlantilla)

With appWord

.Visible = True

.ActiveDocument.SaveAs strNuevoDocumento

.Activate

End With

ManejadorErrorSalir:

Exit Sub

ManejadorError:

If Err.Number = 429 Then

Set appWord = CreateObject(Class:="Word.Application")

Resume Next

Else

MsgBox Err.Description, , "Error Nº: " & Err.Number

Resume ManejadorErrorSalir

End If

End Sub

Private Sub Comando309_Click()

Dim appWord As Word.Application

Dim docs As Word.Documents

Dim doc As Word.Document

Dim campoWord As Object

Dim strRutaPlantilla As String

Dim strTestPlantilla As String

Dim strNuevoDocumento As String

On Error GoTo ManejadorError

' Ruta completa de la plantilla de Word 

strRutaPlantilla = "C:\Blas\Part Acc 2009\Informe accidente.dot"

' Ruta y nombre del nuevo documento 

strNuevoDocumento = "C:\Blas\Part Acc 2009\Atestados\" & Me.IDRefNum & ".doc"

'Sí existe el archivo lo abrimos y nos salimos, 

' sino existe lo creamos 

strTestPlantilla = Nz(Dir(strNuevoDocumento))

If strTestPlantilla <> "" Then

Application.FollowHyperlink strNuevoDocumento

Exit Sub

End If

Set appWord = CreateObject(Class:="Word.Application")

Set docs = appWord.Documents

Set doc = docs.Add(strRutaPlantilla)

Set campoWord = doc.CustomDocumentProperties

On Error Resume Next

campoWord.Item("NombreDeCampoWord").Value = CampoFormulario

campoWord.Item("OtroNombreCampoWord").Value = OtroCampoFormulario

' Sigue con los demás campos de word

With appWord

.Visible = True

.Selection.WholeStory

.Selection.Fields.Update

.ActiveDocument.SaveAs strNuevoDocumento

.Activate

.Selection.EndKey Unit:= wdStory

End With

ManejadorErrorSalir:

Exit Sub

ManejadorError:

If Err.Number = 429 Then

Set appWord = CreateObject(Class:="Word.Application")

Resume Next

Else

MsgBox Err.Description, , "Error Nº: " & Err.Number

Resume ManejadorErrorSalir

End If

End Sub

If strTestPlantilla <> "" Then

Application.FollowHyperlink strNuevoDocumento

Exit Sub

End If

If strTestPlantilla <> "" Then

If MsgBox("El Documento ya existe. ¿Desea actualizarlo", _

vbInformation + vbYesNo + vbDefaultButton2, _

"Actualizar Documento") = vbNo Then

'Esta linea la ponemos solo sí queremos que se abra el documento

Application.FollowHyperlink strNuevoDocumento

Exit Sub

End If

End If