L
Lars Brownies
With the help of Doug Steele (thanks!) I was able to create a function to
open Word docs more smoothly. Maybe it can be of use to someone else. See
below for code and comments.
Lars
Function fOpenWordDoc(strFullPath As String)
On Error GoTo Err_Handler
'Purpose: Open/BringToFront Word document without unwanted messages
'Comment: This function either opens a Word document or,
' if already opened by the user, brings it to front.
' Bringing it to front and not re-opening the Word
' document, prevents the default Word dialog
' (open read only?, etc) to appear.
' If the Word document is already opened by another
' user, the user does get the default Word dialog
' (open read only?, etc). Pressing 'Cancel' on this
' dialog, won't result in a 'Command Failed' message.
'Argument: strFullPath = the full path of the document
Dim oApp As Object
Dim objDoc As Object
Dim strFile As String
Dim booFound As Boolean
10 Set oApp = GetObject(Class:="Word.Application")
'Get filename only (including the extension)
20 strFile = Mid(strFullPath, InStrRev(strFullPath, 1))
'Check if document is already opened by user
30 For Each objDoc In oApp.Documents
40 If objDoc.Name = strFile Then
50 booFound = True
60 Exit For
70 End If
80 Next objDoc
90 If booFound = False Then
100 oApp.Documents.Open FileName:=strFullPath
110 End If
120 oApp.Visible = True
130 oApp.Activate
'Bring the doc to front
140 oApp.WindowState = vbNormal
150 Set oApp = Nothing
Exit_Func: Exit Function
Err_Handler:
Select Case Err.Number
Case 429
'Open Word as it is not opened yet
Set oApp = CreateObject(Class:="Word.Application")
Resume Next
Case Else
'Prevent 'Command failed' message if user wants to cancel
'opening the doc because it is already opened by another user
If Err.Number = 4198 And Erl = 100 Then
Resume Exit_Func
End If
msgbox "Error " & Err.Number & ": " & _
Err.Description & " Line " & Erl
Resume Exit_Func
End Select
End Function
open Word docs more smoothly. Maybe it can be of use to someone else. See
below for code and comments.
Lars
Function fOpenWordDoc(strFullPath As String)
On Error GoTo Err_Handler
'Purpose: Open/BringToFront Word document without unwanted messages
'Comment: This function either opens a Word document or,
' if already opened by the user, brings it to front.
' Bringing it to front and not re-opening the Word
' document, prevents the default Word dialog
' (open read only?, etc) to appear.
' If the Word document is already opened by another
' user, the user does get the default Word dialog
' (open read only?, etc). Pressing 'Cancel' on this
' dialog, won't result in a 'Command Failed' message.
'Argument: strFullPath = the full path of the document
Dim oApp As Object
Dim objDoc As Object
Dim strFile As String
Dim booFound As Boolean
10 Set oApp = GetObject(Class:="Word.Application")
'Get filename only (including the extension)
20 strFile = Mid(strFullPath, InStrRev(strFullPath, 1))
'Check if document is already opened by user
30 For Each objDoc In oApp.Documents
40 If objDoc.Name = strFile Then
50 booFound = True
60 Exit For
70 End If
80 Next objDoc
90 If booFound = False Then
100 oApp.Documents.Open FileName:=strFullPath
110 End If
120 oApp.Visible = True
130 oApp.Activate
'Bring the doc to front
140 oApp.WindowState = vbNormal
150 Set oApp = Nothing
Exit_Func: Exit Function
Err_Handler:
Select Case Err.Number
Case 429
'Open Word as it is not opened yet
Set oApp = CreateObject(Class:="Word.Application")
Resume Next
Case Else
'Prevent 'Command failed' message if user wants to cancel
'opening the doc because it is already opened by another user
If Err.Number = 4198 And Erl = 100 Then
Resume Exit_Func
End If
msgbox "Error " & Err.Number & ": " & _
Err.Description & " Line " & Erl
Resume Exit_Func
End Select
End Function