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

Set Word = GetObject(, "Word.Application") works in one sub, but not in other sub in same document

我有两个代码可以创建 and/or 从 Excel 打开 Word 文档,两者都包含相似的编码,包括语法

Set 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 未打开时不起作用,我忽略了什么?

有问题的和工作的不一样:

您的代码丢失 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,将创建一个新会话。