automation error

?

????? ?????

???"ace join_to (e-mail address removed) (Tony Epton)"?? ??? ??????
Windows XP, Office 2003

Purpose of code is to copy a "template" word doc
Stuff lots of values in to form fields.
Tweak up the header & footer


This code works the first time through
but gives
"Error 462
The remote server machine does not exist or is unavailable"
at the first executable line in
Sub TrickyStuffInHeaderFooter
the second time through

Shutting down access and restarting allows the code to run once before
the problem reoccurs.

I strongly suspect I am not releasing an object somewhere.
I am really desparate for some help please - just spent the last 6
hours banging my head against the wall and the deadline is looming.

Many thanks in advance
Tony


Sub BuildWordDocument(lngEvalId As Long, lngDataEntrySiteId As Long,
boolVerbose As Boolean)
Dim strTemplateQuote As String
Dim xlapp As Word.Application
Dim strTemplate As String
Dim fld As Word.FormField
Dim doc As Word.Document
Dim chk As Word.CheckBox
Dim rsEval As Recordset
Dim rsDet As Recordset
Dim rsImage As Recordset
Dim rsSys As Recordset
Dim intCount As Integer
Dim varFunctionLocNo As Variant
Dim strSource As String
Dim boolRC As Boolean
Dim strImageRootDirectory As String
Dim strFld As String
Dim intOutputDocumentNaming As Integer
Dim varCSId As Variant
Dim strFileName As String
Dim strImageList As String


<some code snipped here - mainly to do with defining strSource>


strTemplate = FileStrip(strSource) & "\" & strFileName & "_" &
Format(Now(), "yymmdd_hhnn") & ".doc"
On Error GoTo CopyFileErr

FileCopy strSource, strTemplate
On Error GoTo 0
GoTo CopyFileNoErr
CopyFileErr:
MsgBox "Unable to copy template to " & strTemplate & vbCrLf &
"because " & Err.Description
On Error GoTo 0
rsEval.Close
Set rsEval = Nothing
Exit Sub
CopyFileNoErr:

strTemplateQuote = Chr(34) & strTemplate & Chr(34)
'
' get handle to word application
'
AceDisplayStatus True, "Starting up Word"
DoEvents
Set xlapp = CreateObject("word.application")
xlapp.Visible = True
'
' open the template word document (destination document)
'
xlapp.Documents.Open FileName:=strTemplateQuote,
ConfirmConversions:= _
False, ReadOnly:=False, AddToRecentFiles:=False,
PasswordDocument:="", _
PasswordTemplate:="", Revert:=False,
WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto
'
' get handle to document object
'
Set doc = xlapp.ActiveDocument
'
' Unprotect the document
'
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect
End If
'
' Poke table values in to all the form fields in the document
'
AceDisplayStatus True, "Header/Footer fields"
TrickyStuffInHeaderFooter doc, rsEval!DocumentNumber,
rsEval!IssueDate, rsEval!ReviewDate
'
' General Fields
'
AceDisplayStatus True, "Filling in General Fields"
DoEvents
DoGeneralFields doc, rsEval

'
' Do sections
'
DoSections doc, lngEvalId

AceDisplayStatus True, "Inserting Images"
'
' Space Plan Images
'
strImageList = InsertImagesIntoDocument(xlapp, "tblSpaceImage",
"SpaceImageTable", boolD, strImageRootDirectory, lngEvalId)
InsertPhotoNotes doc, strImageList, rsEval![SpacePhotoNotes],
"SpacePhotoNotes"
'
' Space Ventilation Images
'
strImageList = InsertImagesIntoDocument(xlapp,
"tblVentilationPlanImage", "VentilationImageTable", boolD,
strImageRootDirectory, lngEvalId)
InsertPhotoNotes doc, strImageList,
rsEval![BaseVentilationPhotoNotes], "BaseVentilationPhotoNotes"
'
' Rescue Plan Images
'
strImageList = InsertImagesIntoDocument(xlapp,
"tblRescuePlanImage", "RescueImageTable", boolD,
strImageRootDirectory, lngEvalId)
InsertPhotoNotes doc, strImageList, rsEval![RescuePlanPhotoNotes],
"RescuePlanPhotoNotes"
'
' Protect the document
'
If doc.ProtectionType = wdNoProtection Then
doc.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End If

'
' Save & close the output document & shut down word
'
AceDisplayStatus True, "Saving the document"
DoEvents
xlapp.ActiveDocument.Save
doc.Close
'xlapp.ActiveWindow.Close
For i = 1 To 100
DoEvents
DoEvents
Next i
Set doc = Nothing
xlapp.Quit
Set xlapp = Nothing
For i = 1 To 100
DoEvents
DoEvents
Next i
AceDisplayStatus False, "Removing Status screen"
rsEval.Close
Set rsEval = Nothing

If boolVerbose Then
MsgBox "Word document has been saved to " & strTemplate
End If
end sub


Sub TrickyStuffInHeaderFooter(doc As Word.Document, varDocumentNumber
As Variant, varIssueDate As Variant, varReviewDate As Variant)
'
' Poke various values in to the header and footer of the document
' (bookmarks and merge fields do not work here so have to manipulate
in code)
'
With doc




'If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
' ActiveWindow.Panes(2).Close
'End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or
ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = "hXXX-XXX-XXX-XXX"
.Replacement.Text = Nz(varDocumentNumber, " ")
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = "fXXX-XXX-XXX-XXX"
.Replacement.Text = Nz(varDocumentNumber, " ")
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "idd/mm/yyyy"
If IsNull(varIssueDate) Then
.Replacement.Text = " "
Else
.Replacement.Text = Format(varIssueDate, "dd/mm/yyyy")
End If
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "rdd/mm/yyyy"
If IsNull(varReviewDate) Then
.Replacement.Text = " "
Else
.Replacement.Text = Format(varReviewDate, "dd/mm/yyyy")
End If
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

End With
End Sub
 
T

Tony Epton

Windows XP, Office 2003

Purpose of code is to copy a "template" word doc
Stuff lots of values in to form fields.
Tweak up the header & footer


This code works the first time through
but gives
"Error 462
The remote server machine does not exist or is unavailable"
at the first executable line in
Sub TrickyStuffInHeaderFooter
the second time through

Shutting down access and restarting allows the code to run once before
the problem reoccurs.

I strongly suspect I am not releasing an object somewhere.
I am really desparate for some help please - just spent the last 6
hours banging my head against the wall and the deadline is looming.

Many thanks in advance
Tony


Sub BuildWordDocument(lngEvalId As Long, lngDataEntrySiteId As Long,
boolVerbose As Boolean)
Dim strTemplateQuote As String
Dim xlapp As Word.Application
Dim strTemplate As String
Dim fld As Word.FormField
Dim doc As Word.Document
Dim chk As Word.CheckBox
Dim rsEval As Recordset
Dim rsDet As Recordset
Dim rsImage As Recordset
Dim rsSys As Recordset
Dim intCount As Integer
Dim varFunctionLocNo As Variant
Dim strSource As String
Dim boolRC As Boolean
Dim strImageRootDirectory As String
Dim strFld As String
Dim intOutputDocumentNaming As Integer
Dim varCSId As Variant
Dim strFileName As String
Dim strImageList As String


<some code snipped here - mainly to do with defining strSource>


strTemplate = FileStrip(strSource) & "\" & strFileName & "_" &
Format(Now(), "yymmdd_hhnn") & ".doc"
On Error GoTo CopyFileErr

FileCopy strSource, strTemplate
On Error GoTo 0
GoTo CopyFileNoErr
CopyFileErr:
MsgBox "Unable to copy template to " & strTemplate & vbCrLf &
"because " & Err.Description
On Error GoTo 0
rsEval.Close
Set rsEval = Nothing
Exit Sub
CopyFileNoErr:

strTemplateQuote = Chr(34) & strTemplate & Chr(34)
'
' get handle to word application
'
AceDisplayStatus True, "Starting up Word"
DoEvents
Set xlapp = CreateObject("word.application")
xlapp.Visible = True
'
' open the template word document (destination document)
'
xlapp.Documents.Open FileName:=strTemplateQuote,
ConfirmConversions:= _
False, ReadOnly:=False, AddToRecentFiles:=False,
PasswordDocument:="", _
PasswordTemplate:="", Revert:=False,
WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto
'
' get handle to document object
'
Set doc = xlapp.ActiveDocument
'
' Unprotect the document
'
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect
End If
'
' Poke table values in to all the form fields in the document
'
AceDisplayStatus True, "Header/Footer fields"
TrickyStuffInHeaderFooter doc, rsEval!DocumentNumber,
rsEval!IssueDate, rsEval!ReviewDate
'
' General Fields
'
AceDisplayStatus True, "Filling in General Fields"
DoEvents
DoGeneralFields doc, rsEval

'
' Do sections
'
DoSections doc, lngEvalId

AceDisplayStatus True, "Inserting Images"
'
' Space Plan Images
'
strImageList = InsertImagesIntoDocument(xlapp, "tblSpaceImage",
"SpaceImageTable", boolD, strImageRootDirectory, lngEvalId)
InsertPhotoNotes doc, strImageList, rsEval![SpacePhotoNotes],
"SpacePhotoNotes"
'
' Space Ventilation Images
'
strImageList = InsertImagesIntoDocument(xlapp,
"tblVentilationPlanImage", "VentilationImageTable", boolD,
strImageRootDirectory, lngEvalId)
InsertPhotoNotes doc, strImageList,
rsEval![BaseVentilationPhotoNotes], "BaseVentilationPhotoNotes"
'
' Rescue Plan Images
'
strImageList = InsertImagesIntoDocument(xlapp,
"tblRescuePlanImage", "RescueImageTable", boolD,
strImageRootDirectory, lngEvalId)
InsertPhotoNotes doc, strImageList, rsEval![RescuePlanPhotoNotes],
"RescuePlanPhotoNotes"
'
' Protect the document
'
If doc.ProtectionType = wdNoProtection Then
doc.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End If

'
' Save & close the output document & shut down word
'
AceDisplayStatus True, "Saving the document"
DoEvents
xlapp.ActiveDocument.Save
doc.Close
'xlapp.ActiveWindow.Close
For i = 1 To 100
DoEvents
DoEvents
Next i
Set doc = Nothing
xlapp.Quit
Set xlapp = Nothing
For i = 1 To 100
DoEvents
DoEvents
Next i
AceDisplayStatus False, "Removing Status screen"
rsEval.Close
Set rsEval = Nothing

If boolVerbose Then
MsgBox "Word document has been saved to " & strTemplate
End If
end sub


Sub TrickyStuffInHeaderFooter(doc As Word.Document, varDocumentNumber
As Variant, varIssueDate As Variant, varReviewDate As Variant)
'
' Poke various values in to the header and footer of the document
' (bookmarks and merge fields do not work here so have to manipulate
in code)
'
With doc




'If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
' ActiveWindow.Panes(2).Close
'End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or
ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = "hXXX-XXX-XXX-XXX"
.Replacement.Text = Nz(varDocumentNumber, " ")
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = "fXXX-XXX-XXX-XXX"
.Replacement.Text = Nz(varDocumentNumber, " ")
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "idd/mm/yyyy"
If IsNull(varIssueDate) Then
.Replacement.Text = " "
Else
.Replacement.Text = Format(varIssueDate, "dd/mm/yyyy")
End If
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "rdd/mm/yyyy"
If IsNull(varReviewDate) Then
.Replacement.Text = " "
Else
.Replacement.Text = Format(varReviewDate, "dd/mm/yyyy")
End If
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

End With
End Sub
 
T

Tony Epton

Didn't really get any answers on this - maybe my news server is losing
posts, or no one wanted to answer this.

After searching MS KnowledgeBase using the error message
I can now answer my own question (don't know why I didn't look there
first :) )

All of the members in this routine are members of xlapp (the word
application)
not doc (the active document)

So should have xlapp as argument to function, not doc
Also "with doc" should be "with xlapp"
and many of the members are missing a "." in front of them.

The net upshot of this is that the members are referencing the global
instance of word.application instead of the current version. - causing
multiple servers to be kept in memory.
The member that blows up is referencing an older copy of the server
that is not longer set up properly

Tony
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top