I have encountered a problem with some of one of my access databases due to a rollout of security patches and etc at my company. I have an access database that dumps data into a word template. The template contains instructions for filling out the rest of the needed information. I have a button on the word document with caption that says "remove instructions" at that point, I have word try and copy all of the text out of the document with proper formatting into a new word document that has no macros/code behind the scene for a user to fill in their information and save.
Here is the code:
Option Explicit
Dim objword As Object, ObjWordApp As Object, strName As String, aDoc As Document
_______________ _______________ _______________ _______________ _____
Public Sub Document_New()
On Error GoTo errorhandler
Set objword = ActiveDocument
objword.MailMer ge.OpenDataSour ce _
Name:="C:\DbWor k\LtrRes.accde" , _
LinkToSource:=T rue, _
Connection:="QU ERY qryDocument", _
SQLStatement:=" Select * from [qryDocument]"
' Execute the mail merge.
objword.MailMer ge.Execute
objword.Close (0)
errorhandler:
If Err.Number > 0 Then
MsgBox "Data was not pulled for this template. Please use this blank template to manually fill in fields."
End If
End Sub
_______________ _______________ _______________ _______________ _____
Private Sub CommandButton1_ Click()
With ActiveDocument. Content.Find
With Selection.Find
.ClearFormattin g
.Font.Color = wdColorTeal
.Replacement.Cl earFormatting
.Replacement.Te xt = " "
.Execute Replace:=wdRepl aceAll, Forward:=True, _
Wrap:=wdFindCon tinue
End With
End With
DeleteThis
End Sub
_______________ _______________ _______________ _______________ ______
Private Sub DeleteThis()
Dim o As Object
'ActiveDocument .ToggleFormsDes ign
For Each o In ActiveDocument. InlineShapes
If o.OLEFormat.Obj ect.Caption = "Remove Instructions" Then
o.Delete
End If
Next
strName = ActiveDocument. Name
CopyDoc (strName)
Documents(strNa me).Close (0)
End Sub
_______________ _______________ _______________ _______________ ______
Public Sub CopyDoc(DocName As String)
Documents(DocNa me).Range.Start Of Unit:=wdSection , Extend:=wdExten d
Documents(DocNa me).Range.MoveE nd Unit:=wdSection
Documents(DocNa me).Select
Selection.Copy
Documents.Add DocumentType:=w dNewBlankDocume nt
Selection.Paste AndFormat (wdFormatOrigin alFormatting)
End Sub
Basically what happens is it just crashes out and nothing gets copied into the new word document. Any help would be greatly appreciated. Let me know if you need anymore deatils
Here is the code:
Option Explicit
Dim objword As Object, ObjWordApp As Object, strName As String, aDoc As Document
_______________ _______________ _______________ _______________ _____
Public Sub Document_New()
On Error GoTo errorhandler
Set objword = ActiveDocument
objword.MailMer ge.OpenDataSour ce _
Name:="C:\DbWor k\LtrRes.accde" , _
LinkToSource:=T rue, _
Connection:="QU ERY qryDocument", _
SQLStatement:=" Select * from [qryDocument]"
' Execute the mail merge.
objword.MailMer ge.Execute
objword.Close (0)
errorhandler:
If Err.Number > 0 Then
MsgBox "Data was not pulled for this template. Please use this blank template to manually fill in fields."
End If
End Sub
_______________ _______________ _______________ _______________ _____
Private Sub CommandButton1_ Click()
With ActiveDocument. Content.Find
With Selection.Find
.ClearFormattin g
.Font.Color = wdColorTeal
.Replacement.Cl earFormatting
.Replacement.Te xt = " "
.Execute Replace:=wdRepl aceAll, Forward:=True, _
Wrap:=wdFindCon tinue
End With
End With
DeleteThis
End Sub
_______________ _______________ _______________ _______________ ______
Private Sub DeleteThis()
Dim o As Object
'ActiveDocument .ToggleFormsDes ign
For Each o In ActiveDocument. InlineShapes
If o.OLEFormat.Obj ect.Caption = "Remove Instructions" Then
o.Delete
End If
Next
strName = ActiveDocument. Name
CopyDoc (strName)
Documents(strNa me).Close (0)
End Sub
_______________ _______________ _______________ _______________ ______
Public Sub CopyDoc(DocName As String)
Documents(DocNa me).Range.Start Of Unit:=wdSection , Extend:=wdExten d
Documents(DocNa me).Range.MoveE nd Unit:=wdSection
Documents(DocNa me).Select
Selection.Copy
Documents.Add DocumentType:=w dNewBlankDocume nt
Selection.Paste AndFormat (wdFormatOrigin alFormatting)
End Sub
Basically what happens is it just crashes out and nothing gets copied into the new word document. Any help would be greatly appreciated. Let me know if you need anymore deatils
Comment