Check if Word Document is already opened + Error Handling - excel

Question

Hello and thank you for your answers in advance.
I am opening a word document using excel-vba and save it under a new name.
This is actually working fine.
But problems occur if the word document with the new name is already opened!
Let's say there is a button to run the script and the user runs it the second time, and has the created file still opened. The user might change something in excel and now wants to check how the new word document would look like afterwords. He will click the button again.
It will open the template (do all changes) and try to save it, but can't because it is already opened and it might save this document with the old name (template) instead of a new file. Therefor it will overwrite and destroy the template file (got this several times during testing)!
Therefore I am in need of some proper code and a better Error-Handling. My first thought is to check if the document with the filename already exists. But it does not quite do its job:
Sub CreateWordDocument()
Dim TemplName, CurrentLocation, DocumentName, Document As String
Dim WordDoc, WordApp, OutApp As Object
With table1
TemplName = table1.Range("A1").Value 'Get selected template name
CurrentLocation = Application.ActiveWorkbook.Path 'working folder
Template = CurrentLocation + "\" + TemplName
DocumentName = .Range("A2").Value
Document = CurrentLocation + "\" + DocumentName + ".docx"
'Open Word Template
On Error Resume Next 'if Word is already running
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If
'if document is already opened in word than close it
'if its not possible to close it - end application to prevent any damage to the template
On Error GoTo notOpen
Set WordDoc = WordApp.Documents(DocumentName + ".docx")
On Error GoTo closeError
WordDoc.Close
notOpen:
'Open the template
Set WordDoc = WordApp.Documents.Open(Filename:=Template, ReadOnly:=False) 'Open Template
'save with new name
WordDoc.SaveAs Document
closeError:
'open a message box and tell user to close and run again.
At the current stage it just jumpes from "Set WordDoc = WordApp. ..." to notOpened. Any suggestions how to solve this issue?

Answer 1

Add this function:
Public Function FileIsOpen(FullFilePath As String) As Boolean
Dim ff As Long
On Error Resume Next
ff = FreeFile()
Open FullFilePath For Input Lock Read As #ff
Close ff
FileIsOpen = (Err.Number <> 0)
On Error GoTo 0
End Function
Then use in your code:
If Not FileIsOpen(DocumentName & ".docx") Then
Set WordDoc = WordApp.Documents.Open(Filename:=Template, ReadOnly:=False)
Else
'Do something else because the file is already open.
End If
The document name must be the full path to the document.
Couple of other things:
Only Document is a string, and OutApp is an object. All other variables are Variants.
Dim TemplName, CurrentLocation, DocumentName, Document As String
Dim WordDoc, WordApp, OutApp As Object
It should be:
Dim TemplName As String, CurrentLocation As String, DocumentName As String, Document As String
Dim WordDoc As Object, WordApp As Object, OutApp As Object
VBA generally uses + for addition, and & for concatenation.
DocumentName + ".docx"
would be better written as
DocumentName & ".docx"
Document is a reserved word in Word. It shouldn't cause too much problem here as the code is in Excel, but something to keep in mind.