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中的代码应该不会在这里引起太多问题，但要记住一点。

Answer 2

听起来您需要一种方法来测试Word窗口是否存在。

这里有一些代码可以帮助您。在尝试从Excel运行此代码之前，请确保添加对Microsoft Word Object Library（任何版本）的引用。

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

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

2 个答案: