Home » excel » excel – Check if Word Document is already opened + Error Handling

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

Posted by: admin May 14, 2020 Leave a comment


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
        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
        'Open the template
        Set WordDoc = WordApp.Documents.Open(Filename:=Template, ReadOnly:=False) 'Open Template
    'save with new name
    WordDoc.SaveAs Document
    '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?

How to&Answers:

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)
    '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.