Проверьте, открыт ли документ Word + Обработка ошибок

Question

Здравствуйте и спасибо за ваши ответы заранее.

Я открываю текстовый документ с помощью excel-vba и сохраняю его под новым именем.Это на самом деле работает нормально.

Но проблемы возникают, если слово document с новым именем уже открыто!

Допустим, есть кнопка для запуска сценария, и пользователь запускает его во второй раз, и у него есть созданныйфайл все еще открыт.Пользователь может что-то изменить в Excel и теперь хочет проверить, как новый документ word будет выглядеть после слов.Он снова нажмет кнопку.Он откроет шаблон (выполнит все изменения) и попытается сохранить его, но не сможет, потому что он уже открыт и может сохранить этот документ со старым именем (шаблоном) вместо нового файла.Для этого он перезапишет и уничтожит файл шаблона (получил это несколько раз во время тестирования)!

Поэтому мне нужен какой-то правильный код и лучшая обработка ошибок.Моя первая мысль - проверить, существует ли уже документ с именем файла.Но он не совсем справляется со своей задачей:

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.

На текущем этапе он просто переходит с «Set WordDoc = WordApp. ...» на notOpened.Любые предложения, как решить эту проблему?

Answer 1

Добавить эту функцию:

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 

Тогда используйте в своем коде:

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

Имя документа должно быть полным путем к документу.

---

Пара других вещей:

Только Document является строкой, а OutApp является объектом. Все остальные переменные Variants.

Dim TemplName, CurrentLocation, DocumentName, Document As String  
Dim WordDoc, WordApp, OutApp As Object

Должно быть:

Dim TemplName As String, CurrentLocation As String, DocumentName As String, Document As String
Dim WordDoc As Object, WordApp As Object, OutApp As Object 

---

VBA обычно использует + для сложения и & для объединения.

DocumentName + ".docx"  

лучше написать как

DocumentName & ".docx"  

---

Документ является зарезервированным словом в Word. Это не должно вызывать особых проблем, так как код находится в Excel, но что-то следует иметь в виду.

Answer 2

Похоже, вам нужен метод, чтобы проверить, существует ли окно Word.

Вот код, который должен помочь с этим. Обязательно добавьте ссылку на Microsoft Word Object Library (любая версия), прежде чем пытаться запустить этот код из Excel.

Option Explicit

Private Function WordWindowExists(WindowName As String) As Boolean
    WordWindowExists = False
    Dim WordApp     As Word.Application: Set WordApp = GetObject(, "Word.Application")

    If WordApp Is Nothing Then Exit Function

    Dim Windows     As Word.Windows: Set Windows = WordApp.Windows
    Dim Window      As Word.Window

    For Each Window In Windows
        If WindowName = Window.Document.Name Then
            WordWindowExists = True
            Exit Function
        End If
    Next

End Function

Sub FindWindow()
    If WordWindowExists("Document1") Then
        'Do Action when window exists
    Else
        'Do Action when window does not exist
    End If
End Sub