A
Alan
I am running VBA code in Excel to manipulate a Word document, using
Office 2003 running on Windows XP. The following line of code results
in runtime error 462: "remote server machine does not exist or is
unavailable".
WordDoc.Tables(1).PreferredWidth = InchesToPoints(7.82)
If I take that line of code out, everything works fine.
Does anyone know what might be going on here? As an alternative,
is there another way to change the width of a table in Word?
Thanks, Alan
Public Sub CreateWordDocument(ExcelFilePath As String)
Dim WordApp As Object, WordDoc As Object
Dim LastRow As Long, startRow As Long, endRow As Long
Dim TotRowsPage As Long
' Clear objects
If Not (DataWB Is Nothing) Then Set DataWB = Nothing
If Not (DataTableWS Is Nothing) Then Set DataTableWS = Nothing
ChDir SelectInputFileCES.FolderName(ExcelFilePath)
Application.DisplayAlerts = False
Workbooks.Open ExcelFilePath, UpdateLinks:=xlUpdateLinksNever
Set DataWB = ActiveWorkbook
Set DataTableWS = DataWB.Sheets("table")
Application.DisplayAlerts = True
' Start the Word application
Set WordApp = GetWord()
If WordApp Is Nothing Then
MsgBox "Unable to start Microsoft Word", vbCritical,
"Microsoft Word Error"
Exit Sub
End If
' Add a new Word document
WordApp.Documents.Add
Set WordDoc = WordApp.ActiveDocument
' Set up Word document properties
TotRowsPage = 10
LastRow = DataTableWS.UsedRange.Rows.Count
' Find, copy and format business section
startRow = FindRow("Business", 2, DataTableWS)
endRow = FindRow("Cash Flow", 2, DataTableWS)
TotRowsPage = TotRowsPage + endRow - startRow + 2
If (startRow > 0) And (startRow <= endRow) And (endRow <= LastRow)
Then
' Copy table from Excel
DataTableWS.Range("B" & startRow & ":M" & endRow).Copy
' Paste table into Word
With WordApp.Selection
.EndKey Unit:=wdStory
.TypeParagraph
.PasteExcelTable False, False, False
End With
' Set width of table
WordDoc.Tables(1).Select
WordDoc.Tables(1).PreferredWidthType = wdPreferredWidthPoints
WordDoc.Tables(1).PreferredWidth = InchesToPoints(7.82)
End If
Call CleanUp(WordApp, DataWB)
Set WordDoc = Nothing
Set WordApp = Nothing
End Sub
Function GetWord() As Object
' Try to open an existing instance of Word
On Error Resume Next
Set GetWord = GetObject(, "Word.Application")
If Err.Number = 429 Then ' cannot create object
' If Word is not started, start a new instance
Set GetWord = CreateObject("Word.Application")
End If
GetWord.Visible = False
End Function
Sub CleanUp(WordApp As Object, DataWB As Workbook)
'On Error GoTo ExitSafely
WordApp.Application.DisplayAlerts = wdAlertsNone
'Debug.Print "Saving Word document as:" & vbCrLf & _
' DataWB.Path & "\" & Replace(DataWB.Name, ".xls",
".doc")
' Save Word file
WordApp.ActiveDocument.SaveAs DataWB.Path & "\" & Replace
(DataWB.Name, ".xls", ".doc")
' Close the document
WordApp.ActiveDocument.Close
WordApp.Application.ScreenUpdating = True
'Quit Word
Call QuitWord(WordApp)
'MsgBox "Unable to quit Microsoft Word", vbCritical,
"Microsoft Word Error"
' Close the worksheet
Application.DisplayAlerts = False
DataWB.Close
Application.DisplayAlerts = True
Set DataWB = Nothing
MsgBox "Please open the generated Word document and review it",
vbOKOnly, "Completed"
Exit Sub
ExitSafely:
On Error Resume Next
Application.DisplayAlerts = False
MsgBox "Word file may not have been saved", vbCritical, "Microsoft
Word Error"
'Word.ActiveDocument.Close
Call QuitWord(WordApp)
DataWB.Close
Set DataWB = Nothing
Application.DisplayAlerts = True
On Error GoTo 0
WordApp.Application.ScreenUpdating = True
End Sub
Public Sub QuitWord(WordApp As Object)
On Error GoTo SafeExit
WordApp.Quit
Set WordApp = Nothing
Exit Sub
SafeExit:
On Error Resume Next
WordApp.Quit
Set WordApp = Nothing
On Error GoTo 0
End Sub
Office 2003 running on Windows XP. The following line of code results
in runtime error 462: "remote server machine does not exist or is
unavailable".
WordDoc.Tables(1).PreferredWidth = InchesToPoints(7.82)
If I take that line of code out, everything works fine.
Does anyone know what might be going on here? As an alternative,
is there another way to change the width of a table in Word?
Thanks, Alan
Public Sub CreateWordDocument(ExcelFilePath As String)
Dim WordApp As Object, WordDoc As Object
Dim LastRow As Long, startRow As Long, endRow As Long
Dim TotRowsPage As Long
' Clear objects
If Not (DataWB Is Nothing) Then Set DataWB = Nothing
If Not (DataTableWS Is Nothing) Then Set DataTableWS = Nothing
ChDir SelectInputFileCES.FolderName(ExcelFilePath)
Application.DisplayAlerts = False
Workbooks.Open ExcelFilePath, UpdateLinks:=xlUpdateLinksNever
Set DataWB = ActiveWorkbook
Set DataTableWS = DataWB.Sheets("table")
Application.DisplayAlerts = True
' Start the Word application
Set WordApp = GetWord()
If WordApp Is Nothing Then
MsgBox "Unable to start Microsoft Word", vbCritical,
"Microsoft Word Error"
Exit Sub
End If
' Add a new Word document
WordApp.Documents.Add
Set WordDoc = WordApp.ActiveDocument
' Set up Word document properties
TotRowsPage = 10
LastRow = DataTableWS.UsedRange.Rows.Count
' Find, copy and format business section
startRow = FindRow("Business", 2, DataTableWS)
endRow = FindRow("Cash Flow", 2, DataTableWS)
TotRowsPage = TotRowsPage + endRow - startRow + 2
If (startRow > 0) And (startRow <= endRow) And (endRow <= LastRow)
Then
' Copy table from Excel
DataTableWS.Range("B" & startRow & ":M" & endRow).Copy
' Paste table into Word
With WordApp.Selection
.EndKey Unit:=wdStory
.TypeParagraph
.PasteExcelTable False, False, False
End With
' Set width of table
WordDoc.Tables(1).Select
WordDoc.Tables(1).PreferredWidthType = wdPreferredWidthPoints
WordDoc.Tables(1).PreferredWidth = InchesToPoints(7.82)
End If
Call CleanUp(WordApp, DataWB)
Set WordDoc = Nothing
Set WordApp = Nothing
End Sub
Function GetWord() As Object
' Try to open an existing instance of Word
On Error Resume Next
Set GetWord = GetObject(, "Word.Application")
If Err.Number = 429 Then ' cannot create object
' If Word is not started, start a new instance
Set GetWord = CreateObject("Word.Application")
End If
GetWord.Visible = False
End Function
Sub CleanUp(WordApp As Object, DataWB As Workbook)
'On Error GoTo ExitSafely
WordApp.Application.DisplayAlerts = wdAlertsNone
'Debug.Print "Saving Word document as:" & vbCrLf & _
' DataWB.Path & "\" & Replace(DataWB.Name, ".xls",
".doc")
' Save Word file
WordApp.ActiveDocument.SaveAs DataWB.Path & "\" & Replace
(DataWB.Name, ".xls", ".doc")
' Close the document
WordApp.ActiveDocument.Close
WordApp.Application.ScreenUpdating = True
'Quit Word
Call QuitWord(WordApp)
'MsgBox "Unable to quit Microsoft Word", vbCritical,
"Microsoft Word Error"
' Close the worksheet
Application.DisplayAlerts = False
DataWB.Close
Application.DisplayAlerts = True
Set DataWB = Nothing
MsgBox "Please open the generated Word document and review it",
vbOKOnly, "Completed"
Exit Sub
ExitSafely:
On Error Resume Next
Application.DisplayAlerts = False
MsgBox "Word file may not have been saved", vbCritical, "Microsoft
Word Error"
'Word.ActiveDocument.Close
Call QuitWord(WordApp)
DataWB.Close
Set DataWB = Nothing
Application.DisplayAlerts = True
On Error GoTo 0
WordApp.Application.ScreenUpdating = True
End Sub
Public Sub QuitWord(WordApp As Object)
On Error GoTo SafeExit
WordApp.Quit
Set WordApp = Nothing
Exit Sub
SafeExit:
On Error Resume Next
WordApp.Quit
Set WordApp = Nothing
On Error GoTo 0
End Sub