Word Doc into excel

[charlee63]

Someone help me I'm getting an error message "Run-Time Error '462': The remote server machine does not exist or is unavailable" . It stops at the Bold Letters. Can someone tell me what to look for?

Sub LoadContract()
Const wdDoNotSaveChanges As Long = 0

Dim WSW As Worksheet
Dim WSZ As Worksheet

Dim LastRow As Long

Dim objWord As Object
Dim objDoc As Object
Dim wdFileName
Set objWord = CreateObject("word.Application")

Set WSc = ThisWorkbook
Set WSW = Worksheets("Participation Tab")
Set WSZ = Worksheets("FileNames")
myTab = WSZ.Cells(2, "G").Value

FPath = WSZ.Cells(1, "G").Value
LastRow = WSZ.Cells(Rows.Count, "A").End(xlUp).Row

For x = 2 To LastRow
Jumk = WSZ.Cells(x, "A").Value
wdFileName = FPath & WSZ.Cells(x, "A").Value

' Booth info
If wdFileName = False Then
Exit Sub
End If

Set objDoc = GetObject(wdFileName)

objWord.Documents.Open (wdFileName)
objWord.Selection.WholeStory
objWord.Selection.Copy

ActiveWorkbook.Worksheets("H Import").Select
ActiveWorkbook.Worksheets("H Import").Range("A1").Select
ActiveWorkbook.ActiveSheet.Paste

objDoc.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit


Application.Calculation = xlManual
LastRow = WSW.Cells(Rows.Count, "A").End(xlUp).Row

Set WSc = Worksheets("Import Data")
Dim LastRow2 As Long
LastRow2 = WSW.Cells(Rows.Count, "A").End(xlUp).Row

If WSc.Cells(11, "B").Value = "" Then
WSW.Cells(LastRow2, "A").Value = "Need AP"
Else
WSW.Cells(LastRow2, "A").Value = WSc.Cells(11, "B").Value ' AP B11
End If
WSW.Cells(LastRow2, "C").Value = WSc.Cells(15, "B").Value ' New Vendor B15
WSW.Cells(LastRow2, "D").Value = WSc.Cells(9, "B").Value ' Salles Rep B9
WSW.Cells(LastRow2, "E").Value = WSc.Cells(10, "B").Value ' Broker B10
WSW.Cells(LastRow2, "F").Value = WSc.Cells(12, "B").Value ' Telephone B12
WSW.Cells(LastRow2, "G").Value = WSc.Cells(13, "B").Value ' Email B13
WSW.Cells(LastRow2, "H").Value = WSc.Cells(14, "B").Value ' Auth B14
WSW.Cells(LastRow2, "M").Value = WSc.Cells(23, "B").Value ' Samples B23
' Dept
If WSc.Cells(2, "O").Value > 1 Or WSc.Cells(2, "O").Value = 0 Then
MyDept = "Issue" ' Dept Row 2 A-N
Else
Col = 1
junk2 = WSc.Cells(2, Col).Value
While WSc.Cells(2, Col).Value <> "X" And Col < 15
Col = Col + 1
Wend
MyDept = WSc.Cells(1, Col).Value
End If
WSW.Cells(LastRow2, "I").Value = MyDept ' Dept Row 2 A-N
' Booth Size & Company
MyRow = 4
junk2 = WSc.Cells(MyRow, "C").Value
While WSc.Cells(MyRow, "C").Value = "" And MyRow < 7
MyRow = MyRow + 1
Wend
If MyRow = 7 Then
WSW.Cells(LastRow2, "J").Value = "Issue" ' Booth Size B4-7
WSW.Cells(LastRow2, "N").Value = "Issue"
WSW.Cells(LastRow2, "B").Value = "No Company Name Given" ' Company B4-6
Else
If MyRow = 4 Then
WSW.Cells(LastRow2, "J").Value = 2 ' Booth Size B4-7
WSW.Cells(LastRow2, "B").Value = WSc.Cells(4, "B").Value ' Company B4-6
Else
If MyRow = 5 Then
WSW.Cells(LastRow2, "J").Value = 1 ' Booth Size B4-7
WSW.Cells(LastRow2, "B").Value = WSc.Cells(5, "B").Value ' Company B4-6
Else
If MyRow = 6 Then
WSW.Cells(LastRow2, "J").Value = 0.5 ' Booth Size B4-7
WSW.Cells(LastRow2, "B").Value = WSc.Cells(6, "B").Value ' Company B4-6
End If
End If
End If
WSW.Cells(LastRow2, "N").Value = WSc.Cells(MyRow, "C").Value ' Booth Cost C4-6
End If
' Extra Table
If UCase(WSc.Cells(18, "B").Value) = "X" Then
MyRow = 19
While Not IsEmpty(WSc.Cells(MyRow, "C").Value) And MyRow < 22
MyRow = MyRow + 1
Wend
If MyRow = 22 Then
WSW.Cells(LastRow2, "L").Value = "No Size"
Else
If MyRow = 19 Then
WSW.Cells(LastRow2, "L").Value = "4'" ' Extra Table B18-21
Else
If MyRow = 20 Then
WSW.Cells(LastRow2, "L").Value = "6'" ' Extra Table B18-21
Else
If MyRow = 19 Then
WSW.Cells(LastRow2, "L").Value = "8'" ' Extra Table B18-21
End If
End If
End If
End If
End If
If UCase(WSc.Cells(22, "B").Value) = "X" Then
WSW.Cells(LastRow2, "O").Value = "Yes" ' Electric B22
End If
If UCase(WSc.Cells(16, "B").Value) = "X" Then
WSW.Cells(LastRow2, "S").Value = "Yes" ' Voucher B16
End If
If UCase(WSc.Cells(17, "B").Value) = "X" Then
WSW.Cells(LastRow2, "T").Value = "Yes" ' Check B17
End If
Worksheets("H Import").Columns("A:E").ClearContents
WSW.Select
Application.Calculation = xlAutomatic
Next x
End Sub

 

[NdNoviceHlp]

Dim wdFileName as String

Place this above your error...

Msgbox wdFileName

I think your file path is incorrect. Probably missing the backslash(s). HTH. Dave
ps. please use code tags