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
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