VBA Automation - 462 Error - Server Unavailable

[John Bigness]

From Access, I am running Word and doing a Mail Merge - automated with VBA.
First time it runs fine. Second time I get a 462 Error - "The automation
server is unavailable". After that I close the Access app and all the Word
apps and start over. First try is good. Each one after that is bad.

Is there any way to avoid having to restart the Access application in order
to have the same procedure work again?

 

[Guest]

You are doing something wrong. Have a look at your code
to see what you are doing that is making the automation
server unavailable.

(david)

 

[John Bigness]

Here is the code I am using if you care to take a look. I work around the
error by closing the Access application. Thanks.

Private Sub PrvLtrBtn_Click()

' Preview QA selected Case letter in MS Word and merge data per merge
Fields in letter
' Data viewed in form comes from QALetter [a table made by running
QALetterQ],
' QALetter

is also used for merge to MSWord doc

'Dim stAppName As String
Dim FileX As String

Dim mydbase As Database
Dim rs As Recordset
Dim today As Date

today = Date

'New code to Warn user that file will close when procedure complete
Dim intResponse As Integer

msg = "A Microsoft Word Mail Merge Document will be created and saved. At
the end of the procedure this application will close."
msg = msg & " Do you wish to Proceed? Press Yes to proceed or No to abort
this process."

intResponse = MsgBox(msg, vbQuestion + vbYesNoCancel + vbDefaultButton2,
"Run Mail Merge Process")

'if user does not respond Yes then abort this procedure
If intResponse <> vbYes Then
MsgBox "You have opted not to proceed! Mail Merge Cancelled."
Exit Sub
End If
'

Dim varX As String ' ContactDocW - Selected FormLetter from
ContactType table
Dim varY As String ' ContactCode of selected letter "##"
' which is also first two characters of
filename of .doc

Dim varZ As String

Dim docDate As Date
Dim QACaseName As String
Dim WordApp As Word.Application


Dim WordDoc As Word.Document
Dim strDoc As String

' From QALetterForm.LetterCombo
' open ContactType.ContactDocW (MSWord doc) as selected by user



DoCmd.SetWarnings False
DoCmd.OpenQuery "QALetterQ3"
DoCmd.SetWarnings True


' Lookup filename of form letter to open [varX] and code of form letter
[varY]
varX = DLookup("[ContactDocW]", "ContactType", "[ContactScope] =
Forms!QALetterForm!LetterCombo")
varY = DLookup("[ContactCode]", "ContactType", "[ContactScope] =
Forms!QALetterForm!LetterCombo")

On Error GoTo OpenError

Set mydbase = CurrentDb
Set rs = mydbase.OpenRecordset("QALetter")
varZ = rs![QA1-Last]

FileX = Format(varY, "00") & varZ & Format(Date, "mmmddyy") & ".doc"


DoCmd.SetWarnings False
Set WordApp = New Word.Application
Set WordDoc = New Word.Document
strDoc =
"\\Msccfs0a1aa\apps\OCFSIT_Applications\Development_Prevention_Services\FTHA\"
strDoc = strDoc & "QALetters.dot\" & varX

Set WordDoc = WordApp.Documents.Open(strDoc)
WordApp.Visible = True

DoCmd.SetWarnings True
With WordApp

ActiveDocument.MailMerge.OpenDataSource Name:= _

"\\Msccfs0a1aa\apps\OCFSIT_Applications\Development_Prevention_Services\FTHA\Test\QACases.mdb", _
LinkToSource:=True, _
Connection:="TABLE QALetter", _
SQLStatement:="SELECT * FROM [QALetter]"
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With
' Would like code to automatically 'Save' MSWord doc
' to users folder [H:\GG1748\QADocumentation] on the network
'fnpcfs0a1ac'
' ChangeFileOpenDirectory strDoc & "QACaseLettersSent\"
strDoc =
"\\Msccfs0a1aa\apps\OCFSIT_Applications\Development_Prevention_Services\FTHA\"
strDoc = strDoc & "QACaseLettersSent"
ChangeFileOpenDirectory (strDoc)

ActiveDocument.SaveAs FileName:=FileX
Windows(varX).Activate
DoCmd.SetWarnings False
ActiveDocument.Close
ActiveDocument.Close

End With
WordApp.Quit



'DoCmd.SetWarnings False


Set WordApp = Nothing
Set WordDoc = Nothing
rs.Close
MsgBox "Mail Merge Complete. New Letter is saved in the QACaseLettersSent
folder. Application will now close."
Application.Quit
Exit Sub

OpenError:
MsgBox "Application Error - please close application, restart & try again "
& Err.Number

Set WordApp = Nothing
Set WordDoc = Nothing

End Sub

 

[david epsom dot com dot au]

Word hasn't closed correctly. Probably because it hadn't
finished saving the files when it received the .Quit command.

When you try create the next Word Object, the automation
server, which is still running, has problems creating the
new object.

To avoid this problem, turn off background saves, and don't
Quit the word application. Instead, create a word application
object and use it until your program finishes.

The .word automation newsgroup would probably be a better
place to ask questions like this.

(david)

Here is the code I am using if you care to take a look. I work around the
error by closing the Access application. Thanks.

Private Sub PrvLtrBtn_Click()

' Preview QA selected Case letter in MS Word and merge data per merge
Fields in letter
' Data viewed in form comes from QALetter [a table made by running
QALetterQ],
' QALetter

is also used for merge to MSWord doc

'Dim stAppName As String
Dim FileX As String

Dim mydbase As Database
Dim rs As Recordset
Dim today As Date

today = Date

'New code to Warn user that file will close when procedure complete
Dim intResponse As Integer

msg = "A Microsoft Word Mail Merge Document will be created and saved. At
the end of the procedure this application will close."
msg = msg & " Do you wish to Proceed? Press Yes to proceed or No to abort
this process."

intResponse = MsgBox(msg, vbQuestion + vbYesNoCancel + vbDefaultButton2,
"Run Mail Merge Process")

'if user does not respond Yes then abort this procedure
If intResponse <> vbYes Then
MsgBox "You have opted not to proceed! Mail Merge Cancelled."
Exit Sub
End If
'

Dim varX As String ' ContactDocW - Selected FormLetter from
ContactType table
Dim varY As String ' ContactCode of selected letter "##"
' which is also first two characters of
filename of .doc

Dim varZ As String

Dim docDate As Date
Dim QACaseName As String
Dim WordApp As Word.Application


Dim WordDoc As Word.Document
Dim strDoc As String

' From QALetterForm.LetterCombo
' open ContactType.ContactDocW (MSWord doc) as selected by user



DoCmd.SetWarnings False
DoCmd.OpenQuery "QALetterQ3"
DoCmd.SetWarnings True


' Lookup filename of form letter to open [varX] and code of form letter
[varY]
varX = DLookup("[ContactDocW]", "ContactType", "[ContactScope] =
Forms!QALetterForm!LetterCombo")
varY = DLookup("[ContactCode]", "ContactType", "[ContactScope] =
Forms!QALetterForm!LetterCombo")

On Error GoTo OpenError

Set mydbase = CurrentDb
Set rs = mydbase.OpenRecordset("QALetter")
varZ = rs![QA1-Last]

FileX = Format(varY, "00") & varZ & Format(Date, "mmmddyy") & ".doc"


DoCmd.SetWarnings False
Set WordApp = New Word.Application
Set WordDoc = New Word.Document
strDoc =
"\\Msccfs0a1aa\apps\OCFSIT_Applications\Development_Prevention_Services\FTHA\"
strDoc = strDoc & "QALetters.dot\" & varX

Set WordDoc = WordApp.Documents.Open(strDoc)
WordApp.Visible = True

DoCmd.SetWarnings True
With WordApp

ActiveDocument.MailMerge.OpenDataSource Name:= _

"\\Msccfs0a1aa\apps\OCFSIT_Applications\Development_Prevention_Services\FTHA\Test\QACases.mdb",
_
LinkToSource:=True, _
Connection:="TABLE QALetter", _
SQLStatement:="SELECT * FROM [QALetter]"
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With
' Would like code to automatically 'Save' MSWord doc
' to users folder [H:\GG1748\QADocumentation] on the network
'fnpcfs0a1ac'
' ChangeFileOpenDirectory strDoc & "QACaseLettersSent\"
strDoc =
"\\Msccfs0a1aa\apps\OCFSIT_Applications\Development_Prevention_Services\FTHA\"
strDoc = strDoc & "QACaseLettersSent"
ChangeFileOpenDirectory (strDoc)

ActiveDocument.SaveAs FileName:=FileX
Windows(varX).Activate
DoCmd.SetWarnings False
ActiveDocument.Close
ActiveDocument.Close

End With
WordApp.Quit



'DoCmd.SetWarnings False


Set WordApp = Nothing
Set WordDoc = Nothing
rs.Close
MsgBox "Mail Merge Complete. New Letter is saved in the QACaseLettersSent
folder. Application will now close."
Application.Quit
Exit Sub

OpenError:
MsgBox "Application Error - please close application, restart & try again
"
& Err.Number

Set WordApp = Nothing
Set WordDoc = Nothing

End Sub

You are doing something wrong. Have a look at your code
to see what you are doing that is making the automation
server unavailable.

(david)