运行时错误'429':ActiveX组件无法创建对象VBA

use*_*309 11 excel vba activex object excel-vba

我试图使用Excel VBA保存Word文档,但我收到错误"ActiveX组件无法创建对象".

当我调试时,错误来自以下行:Set wrdApps = CreateObject("Word.Application").它工作正常,但它刚刚开始给我这个错误.有谁知道如何解决这一问题?谢谢您的帮助!

Sub saveDoc()

Dim i As Integer
For i = 1 To 2661:
    Dim fname As String
    Dim fpath As String

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    fname = ThisWorkbook.Worksheets(3).Range("H" & i).Value
    fpath = ThisWorkbook.Worksheets(3).Range("G" & i).Value

    Dim wrdApps As Object
    Dim wrdDoc As Object

    Set wrdApps = CreateObject("Word.Application")

    'the next line copies the active document- the ActiveDocument.FullName 
    ' is important otherwise it will just create a blank document
    wrdApps.documents.Add wrdDoc.FullName

    Set wrdDoc = wrdApps.documents.Open(ThisWorkbook.Worksheets(3).Range("f" & i).Value)
    ' do not need the Activate, it will be Activate
    wrdApps.Visible = False  

    ' the next line saves the copy to your location and name
    wrdDoc.SaveAs "I:\Yun\RTEMP DOC & PDF\" & fname

   'next line closes the copy leaving you with the original document
   wrdDoc.Close

   On Error GoTo NextSheet:
NextSheet:
   Resume NextSheet2
NextSheet2:
Next i

With Application
   .DisplayAlerts = True
   .ScreenUpdating = True
   .EnableEvents = True
End With

End Sub
Run Code Online (Sandbox Code Playgroud)

Sim*_*ley 1

wrdDoc 是否已初始化?您是否尝试在设置对象之前使用wrdDoc?

wrdApps.documents.Add wrdDoc.FullName
Set wrdDoc = wrdApps.documents.Open(ThisWorkbook.Worksheets(3).Range("f" & i).Value)
Run Code Online (Sandbox Code Playgroud)

第一行应该是 ActiveDocument.FullName 吗?如注释中所示?所以:

wrdApps.documents.Add ActiveDocument.FullName
Run Code Online (Sandbox Code Playgroud)