Opening a Word document or template from Access


P

PDSue

We have an Access database that has a button on a form to open a Word
document and fill in bookmarks with data from the database record. Then the
user types in various amounts of text, saves & closes the document, and
returns to the record to save it.

We also need to have the Word document prevent the users from closing the
Word document with the "X" or any other method. We have it set to remove all
the toolbars and menu bar, and use a special toolbar we've created. (Word
should reset the toolbars when the doc is closed) It has special buttons for
Save, Resave or Close. The Save & Resave is preset with a specific path to
save to the server, and inserts the case file number as the document name
(with .doc).

The problems are:
(1) The code I have set up in Word to prevent use of "X" and other close
methods in Word doesn't work when you open the doc from Access. (It DOES
work if you are just opening the doc from Word.)
(2) Sometimes the blank document gets overwritten by the user. I have
watched and check and can't figure out how it happens. We need to prevent
that also.
(3) Word is supposed to close after the document is saved/closed, but it
doesn't close (confuses users). (This also DOES work if you are just opening
the doc from Word.)
(4) I currently have the blank as a .doc document, but really would like it
to be a .dot template to ensure that it can't be overwritten, but I'm not
sure how to set that up.

The Access codes were given to me by someone else, who doesn't know what
they do. There is some code in them that doesn't get used. Same with the
RemoveItem code in Word.)

I don't know where the problem lies - on the Access side or Word side.
Something between Access and Word is preventing some Word code to function
properly.

Thanks for any help.

Following are 3 sets of code. (There's a lot) The Access button that opens
the document (with an additional function), and the code that I have in Word
for the toolbars, etc.

Access button OnClick event:
Dim strMsg As String
Dim strcont As String

' on load of form
Dim strPath As String
Dim strFile As String
Dim strTemp As String

txtopenargs = Me.Name

' Make sure Word is visible
Dim mobjWordn As New Word.Application
Dim mobjWords As Word.Application

'If Not mobjWordn Is Nothing Then
If mobjWordn Is Nothing Then
On Error GoTo continue
mobjWordn.Quit
End If

continue:

If Not mobjWords Is Nothing Then
On Error GoTo continue
mobjWords.Quit
End If

Set mobjWordn = mobjWords
Set mobjWords = mobjWordn
Set mobjWords = Nothing
mobjWordn.Visible = True

Set mobjWord = mobjWordn

mstrTemplateDir = "\\Fs-pd-mtz\MGroups\Shared Databases\Investigator
Database"

If Not mobjWord Is Nothing Then

' Turn on the hourglass DON'T UNDERSTAND THE FUCNTION OR NEED FOR
THIS HOURGLASS COMMAND
DoCmd.Hourglass True

strcont = adhCreateFormLetter(mobjWord, Forms(txtopenargs), _
mstrTemplateDir & "\" & mtemplate & adhcTemplateExt) > 0

If adhCreateFormLetter(mobjWord, Forms(txtopenargs), _
mstrTemplateDir & "\" & mtemplate & adhcTemplateExt) > 0 Then
End If

' Turn off the hourglass
DoCmd.Hourglass False

End If

gmcount = 0 'SEE FUNCTION BELOW
==========
Function adhCreateFormLetter(objword As Word.Application, _
frmAny As Form, ByVal strTemplate As String) As Long
Dim mobjWord As New Word.Application

If gmcount = 1 Then
Exit Function
End If

' Performs our data merge by looking at each control on the active form
and searching
' for bookmarks in the selected Word template. For matches the contents
of the control are
' inserted into the template at the bookmark.
' In:
' objWord - pointer to Word.Application object
' frmAny - pointer to form containing data
' strTemplate - full path to Word template
' Out:
' number of substitutions made

On Error GoTo adhCreateFormLetter_Error

Dim objwordDoc As Word.Document
Dim ctlAny As Control
Dim intExtras As Integer
Dim intCount As Integer

' Open a new document based on the selected template
'Set objwordDoc = objword.Documents.Add(strTemplate)
Set objwordDoc = objword.Documents.Open(strTemplate)
gmcount = gmcount + 1

' Loop through the controls on the form and attempt
' to goto Word bookmarks with the same name--
' Use adhValueFromControl to get the value from
' the control (this function copes with numeric and Boolean values, etc.)
For Each ctlAny In frmAny.Controls
' Try to find a bookmark with the same name as the control

If adhInsertAtBookmark(objwordDoc, ctlAny.Name, _
adhValueFromControl(ctlAny)) Then

' For fields that may appear more than once, look for bookmarks
with the control name
' and a sequential number (txtControl1, txtControl2, etc.)
intExtras = 0
Do
intCount = intCount + 1
intExtras = intExtras + 1
Loop Until Not adhInsertAtBookmark(objwordDoc, _
ctlAny.Name & intExtras, adhValueFromControl(ctlAny))
End If
Next

adhCreateFormLetter = intCount
adhCreateFormLetter_Exit:
Exit Function
adhCreateFormLetter_Error:
Select Case Err.Number
Case Else
MsgBox Err.Description, vbExclamation, _
"Error " & Err.Number
End Select
Resume adhCreateFormLetter_Exit
End Function
====================
WORD CODES:

Sub AutoOpen()

Call RemoveItem 'SEE BELOW

' Allows only InvestDet toolbar for this document
Application.CommandBars("Standard").Visible = False
Application.CommandBars("Formatting").Visible = False
Application.CommandBars("Forms").Visible = False
Application.CommandBars("Drawing").Visible = False
Application.CommandBars("Reviewing").Visible = False
Application.CommandBars("Menu Bar").Enabled = False
CommandBars("InvestDet").Visible = True
CommandBars("InvestDet").Enabled = True

' Hides all codes first
ActiveDocument.ActiveWindow.View.ShowAll = False
' Then shows hidden text only for save macro info
ActiveDocument.ActiveWindow.View.ShowHiddenText = True
ActiveDocument.ActiveWindow.View.FieldShading = wdFieldShadingNever

' Position cursor at correct location to start typing
Selection.EndOf Unit:=wdStory, Extend:=wdMove
Selection.MoveEnd Unit:=wdStory
Options.CursorMovement = wdCursorMovementVisual
Selection.MoveEnd Unit:=wdCharacter, Count:=-1

' To allow one click to save the document instead of 2 clicks
Application.Options.ButtonFieldClicks = 1

End Sub
----------------
Sub RemoveItem()
'Removes close command and X button 3/11/05

Dim hWnd, hMnu, y
Const MF_BYPOSITION As Long = 1024
Const MF_GRAYED As Long = 1
Const MF_DISABLED As Long = 2
hWnd = FindWindowA("OPUSApp", 0)
'Obtain the handle to the form's system menu
hMnu = GetSystemMenu(hWnd, 0)
' When the variable I equals any of the following values, the
' corresponding menu item is removed from the list, and the
' button turned off on the program's title bar:
' Close command = 6 Maximize command = 4 Size command = 2
' Separator line = 5 Minimize command = 3 Move command = 1
' Restore Command
= 0
'Remove the system menu Close menu item
'(the last item on the menu is menuItemCount - 1)

For I = 6 To 0 Step -1
y = RemoveMenu(hMnu, I, MF_BYPOSITION)
Next I
End Sub
------------------
Sub SaveInvest()
' Saves investigation details to specific location to link with appropriate
case in Invest database

Dim Message
Message = "BEFORE SAVING - MAKE SURE PD FILE NUMBER IS IN THE ''PD File#''
field on this form above." & vbCrLf & vbCrLf & _
"IF NOT, press ''CANCEL'' AND ADD THE FILE NUMBER OR THESE DETAILS
WILL NOT SAVE CORRECTLY!" & vbCrLf & vbCrLf & _
" [PD File Number format must be: L##L-#### ]" & vbCrLf &
vbCrLf & _
" Do not change anything else in the path or filename."

SavePath = "\\fs-pd-mtz\mgroups\Shared Databases\Investigator Database\Case
Details\"

Selection.GoTo What:=wdGoToBookmark, Name:="txtPDFileNumber"
Selection.MoveEnd Unit:=wdLine, Count:=1
'selects PDFileNumber as doc name, 9 characters only (format: xxxx-xxxx)
txtPDFileNumber = Left(Selection.Text, 9)

'Saves NEW document by PD File Number
SaveName = txtPDFileNumber
Saves = InputBox(Message, "Saving Investigation Details", SavePath &
SaveName & ".doc", 3250, 3020)

If Not (SaveName Like "M*" Or SaveName Like "R*") Then
MsgBox "CHECK AND FIX THE PD FILE NUMBER - it's either blank or
incorrect" & vbCrLf & vbCrLf & _
" (PD File number must be format: L##L-####)"
Exit Sub
End If
If Saves = "" Then
Exit Sub
End If

ActiveDocument.SaveAs FileName:=Saves
Selection.HomeKey Unit:=wdStory

' Resets toolbars
Application.CommandBars("Standard").Visible = True
Application.CommandBars("Formatting").Visible = True
Application.CommandBars("Menu Bar").Enabled = True
ActiveDocument.ActiveWindow.View.FieldShading = wdFieldShadingAlways

Call RestoreMenu
' Closes without prompting to save changes again
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

MsgBox "Your investigation details have been saved." & vbCrLf & vbCrLf & _
"Close MS Word, return to the database record, click SAVE & SUBMIT"

'Closes document and Word DOESN'T WORK
ActiveWindow.Close

End Sub
----------------
Sub RestoreMenu() '3/11/05

'reset X and controlbox
Application.CommandBars("System").Enabled = True
Application.CommandBars("System").Reset

End Sub
 
Ad

Advertisements


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top