Code gives an error of activex

[fraufreda]

hi.
Yesterday the code was working without any bugs. but today i tried it in two machines and it gives me the same error although i haven't change anything in the code. I even restarted my pc but without any success. it give error 429 Activex component can't create an object.

any help would be appreciated

Dim doc As Object, sel As Object
    Dim oWord As Object, oDoc As Object, wRng As Object
    Dim MyPath As String
    Dim file
    Dim ws As Worksheet

    '~~> Establish an EXCEL application object
    'On Error Resume Next
    Set oWord = GetObject(, "Word.Application")
    
    MyPath = "F:\Users\Desktop\My files\"
    file = Dir(MyPath & "*.rtf")

    '~~> Open the Attachement
    Do While file <> ""
    Set oDoc = oWord.Documents.Open(Filename:=MyPath & file, ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=0, XMLTransform:="", _
        Encoding:=1200)

    '~~> Get the comeplete text and copy it
    Set wRng = oDoc.Range
    wRng.Copy

    '~~> Close word Doc
    oDoc.Close
    'paste
        'For Each ws In ThisWorkbook.Sheets
            Set ws = ThisWorkbook.Sheets.Add
            ActiveSheet.Cells(1, 1).Select
            ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
            file = Dir()
        'Next
        
    Loop
    '~~> Clean up
    Set wRng = Nothing: Set oDoc = Nothing: Set oWord = Nothing

 

[wideboydixon]

I suspect it won't work unless MS Word is running already. GetObject gets a current instance. CreateObject would create a new one.

WBD

 

[fraufreda]

thank you for your reply
it is back to work now. I just put the code into a new workbook.