excel macro copy from word error 462

[hroush]

Working in Excel and Word 2010.

I've nearly completed this macro, but I can't get rid of this re-run error, 462. I've been reading a bunch of forums stating how I have to point everything to my variable instead of Word, but I'm still having problems. This is my first time writing a macro involving Word, so I don't know what else I'm missing. It wouldn't surprise me if it's just one line. I also have control panel open and all instances of Word closes with the end of the macro, but I still get the error. I thought about leaving out some of the formatting stuff, but knowing my luck that is where the problem would lie. To test, just create a document with a word table and have a worksheet named Original.

Sub ImportWordTable()
Dim oNewDoc As Document
Dim exl As Object
Dim wdDoc As Object
Dim wdFileName As Variant
Dim tableNo As Integer 'table number in Word
Dim oTable As Object

On Error GoTo errorHandler

Set exl = ThisWorkbook
exl.Application.ScreenUpdating = False

'get file name
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

'discover which table, if multiple
With wdDoc
tableNo = wdDoc.Tables.Count
If tableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf tableNo > 1 Then
tableNo = InputBox(wdFileName & " contains " & tableNo & " tables." & vbCrLf & _
"Which table would you like to import?", "Import Word Table", "5")
'Stop
End If

'copy table into new document
Set oNewDoc = Documents.Add
Set oTable = wdDoc.Tables(tableNo)
oTable.Range.Copy
oNewDoc.Range.Paste
End With

wdDoc.Application.Visible = True
oNewDoc.Application.Visible = True

'replace new lines with transferable symbols
With oNewDoc.Application.Selection.Find
        .Text = "^13"
        .Replacement.Text = "$$$$$"
        .Execute Replace:=wdReplaceAll
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

'copy into excel
Set oTable = oNewDoc.Tables(1)
oTable.Range.Copy

Sheets.Add.Name = "Revisions"
Sheets("Revisions").Range("C3").Select
ActiveSheet.Paste

Cells.Replace What:="$$$$$", Replacement:=Chr(10), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'some table moficifations
Range("F:G").Delete
Range("C2:E3").Rows.Delete
exl.Application.Sheets("Original").Select
Range("A1:J2").Select
Selection.Copy
Sheets("Revisions").Select
Range("A1").Select
ActiveSheet.Paste

'delete a couple extra blank rows
For i = Range("C65536").End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i

'provide a pretty border
Range(Cells(1, "A"), Cells(Range("C65536").End(xlUp).Row, "J")).Select
With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
     With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
'hide first two columns, though doesn't appear to want to work
Range("A:B").Select
Selection.EntireColumn.Hidden = True
Columns.AutoFit

'put table into new workbook (user will rename and save)
Sheets("Revisions").Move
Range("A1").Select

'close working document and close variables
oNewDoc.Close (False)

Set oNewDoc = Nothing
Set wdDoc = Nothing
Set wdFileName = Nothing
Set oTable = Nothing

exl.Application.Visible = True
exl.Application.ScreenUpdating = True

Exit Sub

errorHandler:

'Stop
Select Case err
Case 462: 'Word failed to initialize
MsgBox "Word failed to cooperate, please give it a minute and then re-run the macro"
Set oNewDoc = Nothing
Set wdDoc = Nothing
Set wdFileName = Nothing
Set oTable = Nothing

Exit Sub
Case Else
Stop
 MsgBox "Error # " & err & " : " & Error(err)
 Application.Visible = True
Application.ScreenUpdating = True
Resume
End Select

End Sub

 

[hroush]

Problem solved. The problem was where I thought it was, but I couldn't figure out how to fix it. The problem is this line:
Set oNewDoc = Documents.Add

To fix it, I did the following:
1. I created a new variable which is just the word application and set it accordingly
Dim wd As Word.Application
Set wd = CreateObject("word.application")

2. This allowed me to fix the problem by doing this:
Set oNewDoc = wd.Documents.Add

3. At the end of the program, I can now close the word application:
wd.Quit
Set wd = Nothing

Final note, make sure everything else that is Word related is tied to the appropriate variable and then you close them out at the end of the macro.