Error 462 - "The remote server machine does not exist" when working with Word via Excel VBA

[Jasesair]

With the below code, I open a Word document that grabs different ranges etc to produce what's needed. It works perfectly, but only for the first time. On subsequent runs, I get "Error 462 - The remote server does not exist or is unavailable". My research from forums suggests this is common but I can't seem to identify the cause. Any help would be much appreciated.

Sub ExcelRangeToWordv21() 

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Copy Range from Excel
  Set tbl = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b9:i25").SpecialCells(xlCellTypeConstants, 3)
  Set Header = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b1:i7") 
  Set Footer = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b27:i28") 
  Set Sheet = ThisWorkbook.Worksheets("Marking Guides (2)")
'If MS Word is already open
 ' Set WordApp = GetObject("Word.Application")

'If MS Word is not already open then open MS Word
  If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application")

'Make MS Word Visible and Active
  WordApp.Visible = True
 
'Create a New Document
  Set myDoc = WordApp.Documents.Add

'Copy Header range
  Sheet.Select
  Header.Select
  Selection.Copy
  Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Copy Footer range
  Sheet.Select
  Footer.Select

'Set Word Margins
 With WordApp.ActiveDocument.PageSetup
 .Orientation = wdOrientLandscape
 .TopMargin = CentimetersToPoints(0.5)
 .BottomMargin = CentimetersToPoints(1)
 .LeftMargin = CentimetersToPoints(1)
 .RightMargin = CentimetersToPoints(1)
  End With
  
'Change the view to header & footer
If WordApp.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
WordApp.ActiveWindow.Panes(2).Close
End If

'Select the Header range and paste as image
ThisWorkbook.Worksheets("Marking Guides (2)").Range("b1:i7").Copy 
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False

'Select the Footer range and paste as image
ThisWorkbook.Worksheets("Marking Guides (2)").Range("b27:i28").Copy 
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
WordApp.Selection.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
WordApp.Selection.Borders(wdBorderTop).LineWidth = wdLineWidth150pt
WordApp.Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
WordApp.Selection.Borders(wdBorderBottom).LineWidth = wdLineWidth150pt
WordApp.Selection.InsertAfter ("Comments:")
WordApp.Selection.InsertAfter Chr(13)


WordApp.ActiveWindow.View.Type = wdNormalView
WordApp.ActiveWindow.View.Type = wdPrintView


'Copy Excel Table range
  Sheet.Select
  tbl.Copy
 
'Paste Table into Word
myDoc.Content.Paste


'Autofit Table so it fits inside Word Document
 Set WordTable = myDoc.Tables(1)
 WordTable.AutoFitBehavior (wdAutoFitWindow)
 WordApp.ActiveDocument.Paragraphs.SpaceAfter = 0
 WordTable.RightPadding = CentimetersToPoints(0.1)
 
 Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False
  
  ThisWorkbook.Worksheets("Class Setup").Select
 
   WordApp.Activate


End Sub

 

[NdNoviceHlp]

Hi Jasesair. Trial removing the Wordapp declaration from the sub and placing this at the top of a module...

Public WordApp As Word.Application

HTH. Dave

 

[RoryA]

I can't replicate your error with that code. Which line causes it?

 

[Jasesair]

I can't replicate your error with that code. Which line causes it?

I've worked out that the error only occurs if I close Word between running it a second time. If I leave Word open and run a second time, it all runs as expected.

 

[Jasesair]

Hi Jasesair. Trial removing the Wordapp declaration from the sub and placing this at the top of a module...

Public WordApp As Word.Application

HTH. Dave

Hi Dave, which is the Wordapp declaration? I'm a bit of a novice and what I thought was the declaration, must not be!!

 

[Macropod]

Try:

With WordApp.ActiveDocument.PageSetup
 .Orientation = wdOrientLandscape
 .TopMargin = WordApp.CentimetersToPoints(0.5)
 .BottomMargin = WordApp.CentimetersToPoints(1)
 .LeftMargin = WordApp.CentimetersToPoints(1)
 .RightMargin = WordApp.CentimetersToPoints(1)
End With

 

[Jasesair]

Try:

With WordApp.ActiveDocument.PageSetup
 .Orientation = wdOrientLandscape
 .TopMargin = WordApp.CentimetersToPoints(0.5)
 .BottomMargin = WordApp.CentimetersToPoints(1)
 .LeftMargin = WordApp.CentimetersToPoints(1)
 .RightMargin = WordApp.CentimetersToPoints(1)
End With

I've just tried that and now the error line is down in the Autofit Table section (4th line). I like this change but I don't think the error is actually here. I've worked out that the error only occurs if I close Word between running it a second time. If I leave Word open and run a second time, it all runs as expected.

 

[Macropod]

Your code could be improved considerably. You define ranges, then don't used the defined ranges, you select things that don't need selecting, and so on. Try:

Sub ExcelRangeToWord()
Application.ScreenUpdating = False
Dim xlTbl As Excel.Range, xlHdr As Excel.Range, xlFtr As Excel.Range
Dim wdApp As New Word.Application, wdDoc As Word.Document

'Define Excel Ranges
With ThisWorkbook.Worksheets("Marking Guides (2)")
  Set xlTbl = .Range("b9:i25").SpecialCells(xlCellTypeConstants, 3)
  Set xlHdr = .Range("b1:i7")
  Set xlFtr = .Range("b27:i28")
End With

With wdApp
  'Make MS Word Visible
  .Visible = True
  'Create a New Document
  Set wdDoc = .Documents.Add
  'Set Word Margins
   With wdDoc
    With .PageSetup
      .Orientation = wdOrientLandscape
      .TopMargin = CentimetersToPoints(0.5)
      .BottomMargin = CentimetersToPoints(1)
      .LeftMargin = CentimetersToPoints(1)
      .RightMargin = CentimetersToPoints(1)
    End With
  
    'Copy xlHdr range
    xlHdr.Copy
    .Headers(wdHeaderFooterPrimary).Range.PasteSpecial Link:=False, _
      DataType:=wdPasteEnhancedMetafile, _
      Placement:=wdInLine, DisplayAsIcon:=False
    
    'Copy xlFtr range
    xlFtr.Copy
    With .Footers(wdHeaderFooterPrimary).Range
      .PasteSpecial Link:=False, _
        DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        'Format xlFtr in Word
      With .Tables(1)
        .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
        .Borders(wdBorderTop).LineWidth = wdLineWidth150pt
        .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
        .Borders(wdBorderBottom).LineWidth = wdLineWidth150pt
      End With
      .InsertAfter ("Comments:") & vbCr
    End With
  
    'Copy xlTbl range
    xlTbl.Copy
    .Range.Paste
    'Format xlTbl in Word
    With .Tables(1)
      .AutoFitBehavior (wdAutoFitWindow)
      .RightPadding = CentimetersToPoints(0.1)
    End With
  
    .Paragraphs.SpaceAfter = 0
  End With

  'Show Word Document
  .Activate
End With

Set xlTbl = Nothing: Set xlHdr = Nothing: Set xlFtr = Nothing
Set wdApp = Nothing: Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

 

[NdNoviceHlp]

Hi Jaseair. I'm sure that Macropod has a solution for you. My original response was due to the nature of your error. You were creating a Word application using the locally (within the sub) declared WordApp variable but you were not quitting the application before the end of the routine. At the end of your routine, locally declared variables are "cancelled" and no longer exist so in effect you were orphaning your Word application as it continued on with no variable name related to it. So my suggestion was to declare the variable Public at the top of a module so that it would persist no matter how many times U ran your routine. I have been wrong before and perhaps further comment on this can be provided by others. HTH. Dave

 

[Macropod]

Note: you may still need to use:
wdApp.CentimetersToPoints
rather than just:
CentimetersToPoints