I see, well then I think it's best to keep your Excel UserForm in charge regarding opening and closing the required Word document.
Both your Excel UserForm and the Word document can stay visible on the computers desktop at the same time.
Note that the code prevents manually closing the Word document if the Excel UserForm is active at the same time.
To make this happen first set a reference in your VBA project to the Word Object Library. Be sure the desired project is active, then on the menu click Tools > References and search manually for the library. I'm on Office 2013 having Library version 15.0, you might have another version number, see attached.
After that, create a new Class module into your project: Menu > Insert > Class Module and press F4 to rename that module to CWordEventsSink.
See if this works for you.
View attachment 67326
This goes in the UserForm's module:
VBA Code:
Option Explicit
Private Type TLocals_UserForm
WordApp As Object
WordDoc As Object
WordEvents As CWordEventsSink
IsDocAvailable As Boolean
End Type
Private This As TLocals_UserForm
Private Const WORDDOCUMENT As String = "C:\Users\car19\OneDrive\Desktop\NOTES.docx"
Private Sub UserForm_Terminate()
TerminateWordApp
End Sub
Private Sub cmdCOPY_Click()
With This
If Not .IsDocAvailable Then
InitWordApp
End If
If .IsDocAvailable Then
.WordApp.Selection.EndKey Unit:=wdStory
.WordApp.Selection.TypeText Text:=Me.TextBox1.Text
End If
End With
End Sub
Private Sub InitWordApp()
If VBA.CreateObject("Scripting.FileSystemObject").FileExists(WORDDOCUMENT) Then
With This
If Not IsFileOpen(WORDDOCUMENT) Then
' Word doc can be made available for opening and pasting, proceed
Excel.Application.ActiveWindow.WindowState = xlNormal
Set .WordApp = New Word.Application
Set .WordDoc = .WordApp.Documents.Open(WORDDOCUMENT)
.WordApp.Visible = True
.WordApp.ActiveWindow.WindowState = wdWindowStateNormal
VBA.AppActivate .WordApp.Caption
.IsDocAvailable = True
Set .WordEvents = New CWordEventsSink
.WordEvents.Initialize .WordApp, .WordDoc
Else
' currently the Word Document is in use, disable copy button
.IsDocAvailable = False
MsgBox "Word Document is already open, please get it closed before you proceed!", vbExclamation, WORDDOCUMENT
End If
End With
Else
MsgBox "Word Document doesn't exist!", vbExclamation, WORDDOCUMENT
End If
End Sub
Private Sub TerminateWordApp()
With This
If Not .WordEvents Is Nothing Then
.WordEvents.Terminate argForceDocToClose:=False ' << change argument to True if document needs to be closed
Set .WordEvents = Nothing
Set .WordDoc = Nothing
Set .WordApp = Nothing
.IsDocAvailable = False
End If
End With
End Sub
Private Function IsFileOpen(ByVal argFullName As String) As Boolean
Dim FileNum As Long, ErrNum As Long
FileNum = VBA.FreeFile()
On Error Resume Next
Open argFullName For Input Lock Read As #FileNum
ErrNum = VBA.Err.Number
Close FileNum
IsFileOpen = VBA.CBool(ErrNum)
End Function
This goes in a Class module named CWordEventsSink:
VBA Code:
Option Explicit
Private WithEvents wdApp As Word.Application
Private Type TLocals_CWordEventsSink
DocToWatch As Word.Document
CloseAllowed As Boolean
End Type
Private This As TLocals_CWordEventsSink
Public Sub Initialize(ByVal argWdApp As Word.Application, ByVal argDoc As Word.Document)
Set wdApp = argWdApp
Set This.DocToWatch = argDoc
This.CloseAllowed = False
End Sub
Public Sub Terminate(Optional ByVal argForceDocToClose As Boolean = False)
Set wdApp = Nothing
With This
.DocToWatch.Save
If argForceDocToClose Then
.CloseAllowed = True
.DocToWatch.Close
End If
Set .DocToWatch = Nothing
End With
End Sub
Private Sub wdApp_DocumentBeforeClose(ByVal Doc As Word.Document, Cancel As Boolean)
If VBA.StrComp(Doc.FullName, This.DocToWatch.FullName, vbTextCompare) = 0 Then
If Not This.CloseAllowed Then
Cancel = True
End If
End If
End Sub
