J
Jeremy Gollehon
This looks long, but it really isn't, so please give it a read. Thanks!
I have an XL file that opens a word document in the Workbook_Open event.
It can be open at any time by anyone on the network. However, if the Word
doc is already open, I'm trying to eliminate the need for users to click the
"would you like to open read-only" dialog when the file is open, and the
"would you like to save a copy" dialog when it's closed (through XL
automation). I've got the open working well, I'm having trouble with the
close. For some reason, the ReadOnly property of the Word doc is always
False!!! It would be awesome if someone could help me with this one. You
would need to open Test.doc on another machine, then open the XL file.
Public variables are set up because I work with the document elseware in the
code.
Public Variables in general module:
-----------------------------------------------------------------------
Public Const docName As String = "C:\Test.doc"
Public appWd As Word.Application
-----------------------------------------------------------------------
Here is the open code:
-----------------------------------------------------------------------
Private Sub Workbook_Open()
If Not AppIsRunning("Word") Then Set appWd = Nothing
If appWd Is Nothing Then
If BPToolPak.AppIsRunning("Word") Then
Set appWd = GetObject(, "Word.Application")
Else
Set appWd = New Word.Application
End If
appWd.Visible = True
For Each oDoc In appWd.Documents
If oDoc.FullName = docName Then
Exit Sub
End If
Next oDoc
If FileIsOpen(docName) Then
appWd.Documents.Open (docName), ReadOnly:=1
Else
appWd.Documents.Open (docName)
End If
End If
End Sub
-----------------------------------------------------------------------
Here is the on close code:
-----------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo ExitSub 'if docName was closed manually.
With appWd.Documents(docName)
Debug.Print .ReadOnly
.Close SaveChanges:= Not .ReadOnly '<--PROBLEM DAMN IT!!!
End With
If appWd.Documents.Count = 0 Then appWd.Quit
ExitSub:
End Sub
-----------------------------------------------------------------------
Below, find the FileIsOpen function from Microsoft, documented here,
http://support.microsoft.com/default.aspx?scid=kb;en-us;138621
and the AppIsRunning function, from where I don't remember (sorry!).
-----------------------------------------------------------------------
Function FileIsOpen(Filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open Filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
Select Case errnum
Case 0 ' No error occurred. File is NOT already open by another user.
FileIsOpen = False
Case 70 ' Error # for "File is already opened by another user."
FileIsOpen = True
Case Else ' Another error occurred.
Error errnum
End Select
End Function
Function AppIsRunning(strAppName As String) As Boolean
Dim app As Object
strAppName = strAppName & ".Application"
On Error Resume Next
Set app = GetObject(, strAppName)
If Err.Number = 0 Then
AppIsRunning = True
Err.Clear
End If
End Function
-----------------------------------------------------------------------
I have an XL file that opens a word document in the Workbook_Open event.
It can be open at any time by anyone on the network. However, if the Word
doc is already open, I'm trying to eliminate the need for users to click the
"would you like to open read-only" dialog when the file is open, and the
"would you like to save a copy" dialog when it's closed (through XL
automation). I've got the open working well, I'm having trouble with the
close. For some reason, the ReadOnly property of the Word doc is always
False!!! It would be awesome if someone could help me with this one. You
would need to open Test.doc on another machine, then open the XL file.
Public variables are set up because I work with the document elseware in the
code.
Public Variables in general module:
-----------------------------------------------------------------------
Public Const docName As String = "C:\Test.doc"
Public appWd As Word.Application
-----------------------------------------------------------------------
Here is the open code:
-----------------------------------------------------------------------
Private Sub Workbook_Open()
If Not AppIsRunning("Word") Then Set appWd = Nothing
If appWd Is Nothing Then
If BPToolPak.AppIsRunning("Word") Then
Set appWd = GetObject(, "Word.Application")
Else
Set appWd = New Word.Application
End If
appWd.Visible = True
For Each oDoc In appWd.Documents
If oDoc.FullName = docName Then
Exit Sub
End If
Next oDoc
If FileIsOpen(docName) Then
appWd.Documents.Open (docName), ReadOnly:=1
Else
appWd.Documents.Open (docName)
End If
End If
End Sub
-----------------------------------------------------------------------
Here is the on close code:
-----------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo ExitSub 'if docName was closed manually.
With appWd.Documents(docName)
Debug.Print .ReadOnly
.Close SaveChanges:= Not .ReadOnly '<--PROBLEM DAMN IT!!!
End With
If appWd.Documents.Count = 0 Then appWd.Quit
ExitSub:
End Sub
-----------------------------------------------------------------------
Below, find the FileIsOpen function from Microsoft, documented here,
http://support.microsoft.com/default.aspx?scid=kb;en-us;138621
and the AppIsRunning function, from where I don't remember (sorry!).
-----------------------------------------------------------------------
Function FileIsOpen(Filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open Filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
Select Case errnum
Case 0 ' No error occurred. File is NOT already open by another user.
FileIsOpen = False
Case 70 ' Error # for "File is already opened by another user."
FileIsOpen = True
Case Else ' Another error occurred.
Error errnum
End Select
End Function
Function AppIsRunning(strAppName As String) As Boolean
Dim app As Object
strAppName = strAppName & ".Application"
On Error Resume Next
Set app = GetObject(, strAppName)
If Err.Number = 0 Then
AppIsRunning = True
Err.Clear
End If
End Function
-----------------------------------------------------------------------