Hola tengo estas dos funciones para generar un archivo word:
Primero le doy a un botón que tiene el siguiente codigo:
Private Sub Escrito_DblClick(Cancel As Integer)
Me!Escrito.Class = "Word.Document.8"
Me!Escrito.OLETypeAllowed = acOLELinked ' Especificar el tipo de objeto.
Me!Escrito.Verb = acOLEVerbHide
Me!Escrito.SourceDoc = "C:\MULTA.DOC"
Me!Escrito.Action = acOLECreateLink
End Sub
Luego le doy a otro botón que se supone que me tiene que abrir el word escrito y lo que me aparece es el word en blanco:
Private Sub Comando81_Click()
Dim stDocName As String
Dim stLinkCriteria As String
Dim db As Database
Dim tdfNuevo As TableDef
Dim prpBucle As Property
Dim Aleg As Recordset
Dim SelAleg As Recordset
Dim StrSql As String
If Forms![Expediente]![Recursos].Form![Hecho] = True Then
Forms![Expediente]![Recursos].Form![Escrito].Class = "Word.Document.8"
Forms![Expediente]![Recursos].Form![Escrito].OLETypeAllowed = acOLELinked
Forms![Expediente]![Recursos].Form![Escrito].Verb = acOLEVerbShow
Forms![Expediente]![Recursos].Form![Escrito].Action = acOLEActivate
End If
If Forms![Expediente]![Recursos].Form![Hecho] = False And Forms![Expediente]![Recursos].Form![Procedimiento] <> 0 Then
Set db = CurrentDb
StrSql = "SELECT Alegaciones.idAleg, Alegaciones.DESCRIPCIO, Alegaciones.Agrupada, Alegaciones.TEXTO, Alegaciones.Competencias, Alegaciones.COMPETENCI, AGrupAleg.CodigoAgrup " & _
" FROM Alegaciones LEFT JOIN AGrupAleg ON Alegaciones.idAleg = AGrupAleg.CodigoAleg"
Set Aleg = db.OpenRecordset(StrSql)
Existe_Tabla ("SeleccAleg")
'Comprueba si existe esa tabla y la elimina porque es temporal
'Crea un objeto TableDef nuevo.
Set tdfNuevo = db.CreateTableDef("SeleccAleg")
With tdfNuevo
' Crea los campos y los agrega al objeto
' TableDef nuevo. Debe hacer esto después de
' anexar el objeto TableDef a la colección
' TableDefs de la base de datos Neptuno.
.Fields.Append .CreateField("Sel", dbBoolean)
.Fields.Append .CreateField("IdAleg", dbLong)
.Fields.Append .CreateField("IdAgrup", dbLong)
.Fields.Append .CreateField("Orden", dbLong)
.Fields.Append .CreateField("Nombre", dbText)
.Fields.Append .CreateField("Agrupada", dbBoolean, 1)
.Fields.Append .CreateField("ElTexto", dbMemo)
.Fields.Append .CreateField("Competen", dbText, 15)
' Anexa el objeto TableDef nuevo a la base de
' datos Neptuno.
db.TableDefs.Append tdfNuevo
End With
Set SelAleg = db.OpenRecordset("SELECT * FROM SeleccAleg")
Aleg.MoveFirst
Do Until Aleg.EOF
SelAleg.AddNew
SelAleg!idAleg = Aleg!idAleg
SelAleg!idAgrup = Aleg!CodigoAgrup
SelAleg!Nombre = Aleg!DESCRIPCIO
SelAleg!ElTexto = Aleg!TEXTO
SelAleg!Competen = Aleg!Competencias
SelAleg!Agrupada = Aleg!Agrupada
SelAleg.Update
Aleg.MoveNext
Loop
SelAleg.Close
Aleg.Close
'Me.RecordSource = "SeleccAleg"
Set SelAleg = Nothing
Set Aleg = Nothing
Set db = Nothing
Set tdfNuevo = Nothing
stDocName = "Seleccion"
DoCmd.OpenForm stDocName, , , stLinkCriteria
End If
Exit_Comando81_Click:
Exit Sub
Err_Comando81_Click:
MsgBox Err.Description
Resume Exit_Comando81_Click
End Sub
Por favor si alguien me puede decir donde está el fallo se lo agradecería muchísimo.
Un saludo
