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
以上代码的逻辑是:
- 它会尝试查找 Word 打开会话并创建 Word 对象(如果存在这样的会话)。
- 如果这样的会话不存在,它会引发错误,但
On Error Resume Next
忽略错误。
- 如果无法从现有会话创建 Word 对象,
Nothing
,将创建一个新会话。
我有两个代码可以创建 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
以上代码的逻辑是:
- 它会尝试查找 Word 打开会话并创建 Word 对象(如果存在这样的会话)。
- 如果这样的会话不存在,它会引发错误,但
On Error Resume Next
忽略错误。 - 如果无法从现有会话创建 Word 对象,
Nothing
,将创建一个新会话。