M
Mike
We are having a problem with Word crashing after intercepting the close
event. Please let me know if anyone has seen this behavior before or has
any suggestions on a better way to code this.
When the open document count is 0 or less the code should close the word
application by calling the Class_Terminate function. The function is called
but Word does not close. Word is left in a state where the application is
present and minimized but no documents are open. Generally after that
condition is reached, the next call to Word causes problems.
Option Explicit
Public WithEvents oApp As Word.Application
Public bIgnoreSaveFlag As Boolean
Private Sub Class_Initialize()
' we are going to use a new instance of Word to keep things tidy for
this program
Set oApp = New Word.Application
If oApp Is Nothing Then
MsgBox "Fatal - Unable to initiate Word. PowrSpec will behave
unpredictably. Please restart PowrSpec."
End If
bIgnoreSaveFlag = False
End Sub
Private Sub Class_Terminate()
On Error Resume Next
oApp.Documents.Close
clsWord.oApp.Quit
Set oApp = Nothing
Set clsWord = Nothing
End Sub
Private Sub oApp_DocumentBeforeClose(ByVal Doc As Word.Document, Cancel As
Boolean)
'---------------------------------------------------------------------------
---------
' This routine has three routes to perform its task when a close event is
intercepted:
' 1. Retain your changes and return to the editing session
' 2. Discard your changes, close the document, cancel check-out and
remove from PC
' 3. Save the changes, close the document, check-in to Documentum and
remove from PC
' --------------------------------------------------------------------------
--------
Dim I As Integer
Dim lstat As Long
Dim sLocalPath As String
Dim msg As String
Dim b As Boolean
Dim destination As String
On Error Resume Next
If Doc.Saved = False Then ' we have a dirty file that has not been
saved.
msg = "Document " & Doc.Name & " has been changed. There are three
options:" & vbCrLf
msg = msg & "Yes = Save the changes." & vbCrLf
msg = msg & "No = Discard your changes and close the document." &
vbCrLf
msg = msg & "Cancel = Retain your changes and return to the editing
session."
lstat = MsgBox(msg, vbYesNoCancel + vbMsgBoxSetForeground +
vbSystemModal, "Save and Close?")
If lstat = vbCancel Then ' Retain your changes and return to the
editing session
Cancel = True ' Set this so Word's dialog does not
appear
Doc.Activate
GoTo fini
ElseIf lstat = vbNo Then ' Discard your changes, close the
document and cancel check-out
sLocalPath = g_sAppPath & "\" & Doc.Name
For I = 0 To UBound(udtWord) - 1
If StrComp(Doc.Name, udtWord(I).FileName, 0) = 0 Then
b = clsDctm.CancelCheckout(udtWord(I).DctmPath)
' should catch the return status, if b returns false the
cancel-checkout failed.
' and will present problems when the file is editted
subsequently
If b = False Then
msg = "<Warning> The attempted Cancel Checkout
failed for file: " & vbCrLf
msg = msg & udtWord(I).DctmPath & vbCrLf
msg = msg & "Navigate to the Documentum path shown."
& vbCrLf
msg = msg & "Perform a manual Cancel Check-Out to
the file."
MsgBox msg, vbOKOnly + vbSystemModal +
vbMsgBoxSetForeground, "Cancel Checkout Failed"
End If
Exit For
End If
Next I
UpdateWordTrackingArray Doc.Name
Doc.Close
KillToRecycle sLocalPath
GoTo fini
End If
End If
' Save the changes and check-in to Documentum
For I = 0 To UBound(udtWord) - 1
If StrComp(Doc.Name, udtWord(I).FileName, 0) = 0 Then
Doc.save
' Check the file into Documentum
sLocalPath = g_sAppPath & "\" & udtWord(I).FileName
' If clsDctm.IsCheckedOut(udtWord(I).DctmPath) = True Then
b = clsDctm.PutDocument(udtWord(I).DctmPath, sLocalPath)
If b = False Then
destination = sLocalPath & "_" & Format(Now(),
"yyyymmddhhnnss")
FileCopy sLocalPath, destination
msg = "An error occured during the Documentum Check-In
activity." & vbCrLf
msg = msg & "The current changes to file: " &
udtWord(I).FileName & vbCrLf
msg = msg & "Are located in the file: " & destination &
vbCrLf
msg = msg & "Please MINIMIZE PowrSpec and contact
PowrSpec Support for assistance."
MsgBox msg, vbOKOnly + vbMsgBoxSetForeground, "Error on
Documentum Save"
LogFile msg
End If
UpdateWordTrackingArray Doc.Name
Doc.Close
' End If
KillToRecycle sLocalPath
Exit For ' already processed the file - jump out of the for
loop
End If
Next I
fini:
' hide the Word application if no more docs are open
If oApp.Documents.Count <= 0 Then
oApp.WindowState = wdWindowStateMinimize
Call Class_Terminate
End If
End Sub
Public Sub UpdateWordTrackingArray(ByVal sFname As String)
'---------------------------------------------------------------------------
--
' Will update the udtWord tracking array. Primary purpose is to remove
Word files
' that have been saved and closed.
'---------------------------------------------------------------------------
-
' input:
' sFname (string) - base file name of word file without path
'---------------------------------------------------------------------------
Dim tmpWord() As typWordNames
Dim I As Integer
Dim k As Integer
Dim nUBWD As Integer
On Error Resume Next
nUBWD = UBound(udtWord)
If Err.Number <> 0 Then
' found an array with no content
ReDim udtWord(0)
udtWord(0).DctmPath = ""
udtWord(0).FileName = ""
udtWord(0).WinTitle = ""
Err.Clear
Exit Sub
ElseIf nUBWD = 0 And udtWord(0).DctmPath = "" Then
' found an array at the initial state
Exit Sub
Else
' found an array with content, need to process it.
' dimension tmp array to hold remaining file info
ReDim tmpWord(0 To UBound(udtWord))
k = 0 ' using k as a counter of the remaining records
For I = 0 To UBound(udtWord) - 1
If StrComp(udtWord(I).FileName, sFname, vbBinaryCompare) <> 0
Then
tmpWord(k).DctmPath = udtWord(I).DctmPath
tmpWord(k).FileName = udtWord(I).FileName
tmpWord(k).WinTitle = udtWord(I).WinTitle
k = k + 1
End If
Next I
If k > 0 Then ' There is still something in the array, save it.
ReDim udtWord(0 To k)
For I = 0 To k - 1
udtWord(I).DctmPath = tmpWord(I).DctmPath
udtWord(I).FileName = tmpWord(I).FileName
udtWord(I).WinTitle = tmpWord(I).WinTitle
Next I
Else ' Nothing left in the array, reset it.
ReDim udtWord(0)
udtWord(0).DctmPath = ""
udtWord(0).FileName = ""
udtWord(0).WinTitle = ""
End If
End If
End Sub
event. Please let me know if anyone has seen this behavior before or has
any suggestions on a better way to code this.
When the open document count is 0 or less the code should close the word
application by calling the Class_Terminate function. The function is called
but Word does not close. Word is left in a state where the application is
present and minimized but no documents are open. Generally after that
condition is reached, the next call to Word causes problems.
Option Explicit
Public WithEvents oApp As Word.Application
Public bIgnoreSaveFlag As Boolean
Private Sub Class_Initialize()
' we are going to use a new instance of Word to keep things tidy for
this program
Set oApp = New Word.Application
If oApp Is Nothing Then
MsgBox "Fatal - Unable to initiate Word. PowrSpec will behave
unpredictably. Please restart PowrSpec."
End If
bIgnoreSaveFlag = False
End Sub
Private Sub Class_Terminate()
On Error Resume Next
oApp.Documents.Close
clsWord.oApp.Quit
Set oApp = Nothing
Set clsWord = Nothing
End Sub
Private Sub oApp_DocumentBeforeClose(ByVal Doc As Word.Document, Cancel As
Boolean)
'---------------------------------------------------------------------------
---------
' This routine has three routes to perform its task when a close event is
intercepted:
' 1. Retain your changes and return to the editing session
' 2. Discard your changes, close the document, cancel check-out and
remove from PC
' 3. Save the changes, close the document, check-in to Documentum and
remove from PC
' --------------------------------------------------------------------------
--------
Dim I As Integer
Dim lstat As Long
Dim sLocalPath As String
Dim msg As String
Dim b As Boolean
Dim destination As String
On Error Resume Next
If Doc.Saved = False Then ' we have a dirty file that has not been
saved.
msg = "Document " & Doc.Name & " has been changed. There are three
options:" & vbCrLf
msg = msg & "Yes = Save the changes." & vbCrLf
msg = msg & "No = Discard your changes and close the document." &
vbCrLf
msg = msg & "Cancel = Retain your changes and return to the editing
session."
lstat = MsgBox(msg, vbYesNoCancel + vbMsgBoxSetForeground +
vbSystemModal, "Save and Close?")
If lstat = vbCancel Then ' Retain your changes and return to the
editing session
Cancel = True ' Set this so Word's dialog does not
appear
Doc.Activate
GoTo fini
ElseIf lstat = vbNo Then ' Discard your changes, close the
document and cancel check-out
sLocalPath = g_sAppPath & "\" & Doc.Name
For I = 0 To UBound(udtWord) - 1
If StrComp(Doc.Name, udtWord(I).FileName, 0) = 0 Then
b = clsDctm.CancelCheckout(udtWord(I).DctmPath)
' should catch the return status, if b returns false the
cancel-checkout failed.
' and will present problems when the file is editted
subsequently
If b = False Then
msg = "<Warning> The attempted Cancel Checkout
failed for file: " & vbCrLf
msg = msg & udtWord(I).DctmPath & vbCrLf
msg = msg & "Navigate to the Documentum path shown."
& vbCrLf
msg = msg & "Perform a manual Cancel Check-Out to
the file."
MsgBox msg, vbOKOnly + vbSystemModal +
vbMsgBoxSetForeground, "Cancel Checkout Failed"
End If
Exit For
End If
Next I
UpdateWordTrackingArray Doc.Name
Doc.Close
KillToRecycle sLocalPath
GoTo fini
End If
End If
' Save the changes and check-in to Documentum
For I = 0 To UBound(udtWord) - 1
If StrComp(Doc.Name, udtWord(I).FileName, 0) = 0 Then
Doc.save
' Check the file into Documentum
sLocalPath = g_sAppPath & "\" & udtWord(I).FileName
' If clsDctm.IsCheckedOut(udtWord(I).DctmPath) = True Then
b = clsDctm.PutDocument(udtWord(I).DctmPath, sLocalPath)
If b = False Then
destination = sLocalPath & "_" & Format(Now(),
"yyyymmddhhnnss")
FileCopy sLocalPath, destination
msg = "An error occured during the Documentum Check-In
activity." & vbCrLf
msg = msg & "The current changes to file: " &
udtWord(I).FileName & vbCrLf
msg = msg & "Are located in the file: " & destination &
vbCrLf
msg = msg & "Please MINIMIZE PowrSpec and contact
PowrSpec Support for assistance."
MsgBox msg, vbOKOnly + vbMsgBoxSetForeground, "Error on
Documentum Save"
LogFile msg
End If
UpdateWordTrackingArray Doc.Name
Doc.Close
' End If
KillToRecycle sLocalPath
Exit For ' already processed the file - jump out of the for
loop
End If
Next I
fini:
' hide the Word application if no more docs are open
If oApp.Documents.Count <= 0 Then
oApp.WindowState = wdWindowStateMinimize
Call Class_Terminate
End If
End Sub
Public Sub UpdateWordTrackingArray(ByVal sFname As String)
'---------------------------------------------------------------------------
--
' Will update the udtWord tracking array. Primary purpose is to remove
Word files
' that have been saved and closed.
'---------------------------------------------------------------------------
-
' input:
' sFname (string) - base file name of word file without path
'---------------------------------------------------------------------------
Dim tmpWord() As typWordNames
Dim I As Integer
Dim k As Integer
Dim nUBWD As Integer
On Error Resume Next
nUBWD = UBound(udtWord)
If Err.Number <> 0 Then
' found an array with no content
ReDim udtWord(0)
udtWord(0).DctmPath = ""
udtWord(0).FileName = ""
udtWord(0).WinTitle = ""
Err.Clear
Exit Sub
ElseIf nUBWD = 0 And udtWord(0).DctmPath = "" Then
' found an array at the initial state
Exit Sub
Else
' found an array with content, need to process it.
' dimension tmp array to hold remaining file info
ReDim tmpWord(0 To UBound(udtWord))
k = 0 ' using k as a counter of the remaining records
For I = 0 To UBound(udtWord) - 1
If StrComp(udtWord(I).FileName, sFname, vbBinaryCompare) <> 0
Then
tmpWord(k).DctmPath = udtWord(I).DctmPath
tmpWord(k).FileName = udtWord(I).FileName
tmpWord(k).WinTitle = udtWord(I).WinTitle
k = k + 1
End If
Next I
If k > 0 Then ' There is still something in the array, save it.
ReDim udtWord(0 To k)
For I = 0 To k - 1
udtWord(I).DctmPath = tmpWord(I).DctmPath
udtWord(I).FileName = tmpWord(I).FileName
udtWord(I).WinTitle = tmpWord(I).WinTitle
Next I
Else ' Nothing left in the array, reset it.
ReDim udtWord(0)
udtWord(0).DctmPath = ""
udtWord(0).FileName = ""
udtWord(0).WinTitle = ""
End If
End If
End Sub