时间戳

首页 > 解决方案 > Set Word = GetObject(, "Word.Application") 在一个子中有效，但在同一文档的其他子中无效

excel - Set Word = GetObject(, "Word.Application") 在一个子中有效，但在同一文档的其他子中无效

问题描述

我有两个从 Excel 创建和/或打开 Word 文档的代码，它们都包含相似的编码，包括语法

设置 Word = GetObject(, "Word.Application")

在一个子文件中，文档打开得很好，而在另一个子文件中，上述语法出现运行时错误 429，但仅当 Word 未打开时。Word 打开时，该功能运行良好。

部分工作子代码

Cells(ActiveCell.Row, ActiveSheet.Range("zz_templates").Column).Activate

Range("zz_preventloop").Value = "x"
Application.ScreenUpdating = False

Dim DocType As String
If Range("zz_officeversion").Value = "previous to 2007" Then
DocType = ".doc"
Else
DocType = ".docx"
End If

Dim filename As String
filename = Range("zz_envelope_documents").Value + "/" + Cells(ActiveCell.Row, ActiveSheet.Range("zz_locations_doc").Column).Value + "/"
filename = filename + Cells(ActiveCell.Row, ActiveSheet.Range("zz_eDMSname").Column).Value + DocType
      
If Len(filename) < 256 Then
'check the document type
    If Cells(ActiveCell.Row, ActiveSheet.Range("zz_doctype_doc").Column).Value = ".url" Then ''Opening the .url shortcut
        On Error Resume Next
        ActiveWorkbook.FollowHyperlink Range("zz_envelope_templates").Value + "/" + ActiveSheet.Cells(ActiveCell.Row, ActiveSheet.Range("zz_locations_temp").Column).Value + "/" _
        + ActiveSheet.Cells(ActiveCell.Row, ActiveSheet.Range("zz_hidden_eDMStemp").Column).Value + ".url", NewWindow:=True
    Else
        If Cells(ActiveCell.Row, ActiveSheet.Range("zz_doctype_doc").Column).Value = ".docx" Then
            Application.Calculate
            On Error Resume Next
            Set Word = GetObject(, "Word.Application")
            If Word Is Nothing Then
                Set Word = CreateObject("Word.Application")
            End If

 Rest of sub

部分非工作子代码

Cells(ActiveCell.Row, ActiveSheet.Range("zz_templates").Column).Activate

Range("zz_preventloop").Value = "x"
Application.ScreenUpdating = False
      
Dim DocType As String
If Range("zz_officeversion").Value = "previous to 2007" Then
DocType = ".doc"
Else
DocType = ".docx"
End If
    
'check the document type
If Cells(ActiveCell.Row, ActiveSheet.Range("zz_doctype_template").Column).Value = ".url" Then 
''Opening the .url shortcut
    On Error Resume Next
    ActiveWorkbook.FollowHyperlink Range("zz_envelope_templates").Value + "/" + ActiveSheet.Cells(ActiveCell.Row, ActiveSheet.Range("zz_locations_temp").Column).Value + "/" _
    + ActiveSheet.Cells(ActiveCell.Row, ActiveSheet.Range("zz_hidden_eDMStemp").Column).Value + ".url", NewWindow:=True
Else
    If Cells(ActiveCell.Row, ActiveSheet.Range("zz_doctype_template").Column).Value = ".docx" Then
        Set Word = GetObject(, "Word.Application")
        If Word Is Nothing Then
            Set Word = CreateObject("Word.Application")
        End If

Rest of sub

我在第二个功能中忽略了什么，当 Word 未打开时它不起作用？

标签： excelvbams-word

解决方案

有问题的与工作的不一样：

您的代码丢失On Error Resume Next。

它应该是：

On Error Resume Next
Set Word = GetObject(, "Word.Application")
If Word Is Nothing Then
     Err.Clear: On Error GoTo 0 'good to clear the error and let the code raising an error if the case
     Set Word = CreateObject("Word.Application")
End If
On Error GoTo 0

上述代码的逻辑是：

  1. 如果存在这样的会话，它会尝试查找 Word 打开会话并创建 Word 对象。
  2. 如果这样的会话不存在，它会引发错误，但会On Error Resume Next忽略错误。
  3. 如果无法从现有会话创建 Word 对象，Nothing则创建一个新会话。

推荐阅读