excel - 检查Word文档是否已经打开+错误处理

Question

您好，感谢您提前回答。

我正在使用 excel-vba 打开一个 word 文档并将其保存在一个新名称下。
这实际上工作正常。

但是如果已经打开了新名称的word文档，就会出现问题!

假设有一个运行脚本的按钮，用户第二次运行它，并且创建的文件仍然打开。用户可能会更改 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"  

Document是 Word 中的保留字.它不应该在这里造成太大的问题，因为代码在 Excel ，但要记住一些事情。