T
Ted W9999
I have a client that uses Word to generate mailing labels on Windows NT. They
keep getting this error message when running the labels program:
"The remote server machine does not exist or is unavailable in
Project1.frmSaReceive.PrintLabels at line 102"
Can anyone help?
Here is the code behind the main form:
Option Explicit
Private varNextTime As Variant
Private docMergeDoc As Word.Document
Private strSql As String
Private strMessage As String
Private objWord As Word.Application
Private Sub Form_Load()
On Error GoTo Form_Load_Err
Dim lngSeconds As Long
100 Timer1.Enabled = False
102 Me.Visible = False
Dim blnError As Boolean
104 Call CreateMmFile(blnError)
106 If Not blnError Then
108 Call CreateLabels(True)
'give Word time to format hundreds of records...
110 lngSeconds = Val(Command$)
112 If lngSeconds = 0 Then
114 lngSeconds = 120 'default to 2 minutes if no command line
override
End If
116 varNextTime = DateAdd("s", lngSeconds, Now) 'get next process time
118 Timer1.Enabled = True
120 Timer1.Interval = 10000 'set off timer every 10 seconds
End If
Exit Sub
Form_Load_Err:
MsgBox Err.Description & vbCrLf & _
"in Project1.frmSaReceive.Form_Load " & _
"at line " & Erl
Resume Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
'gets processed every minute; see if this is the one
Private Sub Timer1_Timer()
On Error Resume Next
Dim varNext As Variant
If Now > varNextTime Then
Timer1.Enabled = False
Call PrintLabels
DoEvents
Unload Me
Else
DoEvents
End If
End Sub
Private Sub CreateLabels(Optional blnPrint As Boolean = False)
On Error Resume Next
Dim intErrCtr As Integer
100 intErrCtr = 0
'Attempt to reference Word which is already running.
102 Set objWord = GetObject(, "Word.Application")
104 If objWord Is Nothing Then 'If true, Word is not running.
'Create a new instance of the Word application.
106 Set objWord = New Word.Application
108 If objWord Is Nothing Then 'If true, MS Word 8.0 is not installed.
110 MsgBox "MS Word is not installed on your computer",
vbCritical, "Unable to load Word"
Exit Sub
End If
End If
On Error GoTo Err_CreateLabels
112 objWord.Visible = True
'Add a new document and set a reference to it.
114 Set docMergeDoc = objWord.Documents.Open(gstrAppPath &
"MAILMRG.DOC")
'give it time to load
116 DoEvents
'118 With docMergeDoc.MailMerge
'120 .OpenDataSource Name:=gstrAppPath & "MAILMRG.dat"
'122 .Destination = 0 'wdSendToNewDocument 'try to avoid
reference
'124 .SuppressBlankLines = True
'126 .Execute
' End With
120 docMergeDoc.MailMerge.OpenDataSource Name:=gstrAppPath &
"MAILMRG.dat"
122 docMergeDoc.MailMerge.Destination = 0 'wdSendToNewDocument
'try to avoid reference
124 docMergeDoc.MailMerge.SuppressBlankLines = True
126 docMergeDoc.MailMerge.Execute
'Close docMergeDoc without saving changes.
128 docMergeDoc.Close SaveChanges:=0 'wdDoNotSaveChanges
Exit_CreateLabels:
On Error Resume Next
Exit Sub
Err_CreateLabels:
130 If Err.Number = 4605 Then
132 intErrCtr = intErrCtr + 1
134 If intErrCtr <= 3 Then
135 Sleep (10000) 'Will pause for 10 seconds
136 DoEvents
138 Resume 0
Else
140 strMessage = "Error #" & Err.Number & Err.Description & " at
line " & Erl
142 MsgBox strMessage, vbCritical,
"Project1.frmSaReceive.CreateLabels"
144 Resume Exit_CreateLabels
End If
Else
146 strMessage = "An unexpected error, #" & Err & " : " & Error _
& " has occured at line " & Erl
148 MsgBox strMessage, vbCritical,
"Project1.frmSaReceive.CreateLabels"
150 Resume Exit_CreateLabels
152 Resume 0
End If
End Sub
Private Sub PrintLabels()
On Error GoTo PrintLabels_Err
100 objWord.Documents(1).PrintOut Background:=False
102 While objWord.BackgroundPrintingStatus > 0
104 DoEvents
Wend
105 Set docMergeDoc = Nothing
106 objWord.Quit False
108 Set objWord = Nothing
Exit Sub
PrintLabels_Err:
MsgBox Err.Description & vbCrLf & _
"in Project1.frmSaReceive.PrintLabels " & _
"at line " & Erl
Resume Next
End Sub
keep getting this error message when running the labels program:
"The remote server machine does not exist or is unavailable in
Project1.frmSaReceive.PrintLabels at line 102"
Can anyone help?
Here is the code behind the main form:
Option Explicit
Private varNextTime As Variant
Private docMergeDoc As Word.Document
Private strSql As String
Private strMessage As String
Private objWord As Word.Application
Private Sub Form_Load()
On Error GoTo Form_Load_Err
Dim lngSeconds As Long
100 Timer1.Enabled = False
102 Me.Visible = False
Dim blnError As Boolean
104 Call CreateMmFile(blnError)
106 If Not blnError Then
108 Call CreateLabels(True)
'give Word time to format hundreds of records...
110 lngSeconds = Val(Command$)
112 If lngSeconds = 0 Then
114 lngSeconds = 120 'default to 2 minutes if no command line
override
End If
116 varNextTime = DateAdd("s", lngSeconds, Now) 'get next process time
118 Timer1.Enabled = True
120 Timer1.Interval = 10000 'set off timer every 10 seconds
End If
Exit Sub
Form_Load_Err:
MsgBox Err.Description & vbCrLf & _
"in Project1.frmSaReceive.Form_Load " & _
"at line " & Erl
Resume Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
'gets processed every minute; see if this is the one
Private Sub Timer1_Timer()
On Error Resume Next
Dim varNext As Variant
If Now > varNextTime Then
Timer1.Enabled = False
Call PrintLabels
DoEvents
Unload Me
Else
DoEvents
End If
End Sub
Private Sub CreateLabels(Optional blnPrint As Boolean = False)
On Error Resume Next
Dim intErrCtr As Integer
100 intErrCtr = 0
'Attempt to reference Word which is already running.
102 Set objWord = GetObject(, "Word.Application")
104 If objWord Is Nothing Then 'If true, Word is not running.
'Create a new instance of the Word application.
106 Set objWord = New Word.Application
108 If objWord Is Nothing Then 'If true, MS Word 8.0 is not installed.
110 MsgBox "MS Word is not installed on your computer",
vbCritical, "Unable to load Word"
Exit Sub
End If
End If
On Error GoTo Err_CreateLabels
112 objWord.Visible = True
'Add a new document and set a reference to it.
114 Set docMergeDoc = objWord.Documents.Open(gstrAppPath &
"MAILMRG.DOC")
'give it time to load
116 DoEvents
'118 With docMergeDoc.MailMerge
'120 .OpenDataSource Name:=gstrAppPath & "MAILMRG.dat"
'122 .Destination = 0 'wdSendToNewDocument 'try to avoid
reference
'124 .SuppressBlankLines = True
'126 .Execute
' End With
120 docMergeDoc.MailMerge.OpenDataSource Name:=gstrAppPath &
"MAILMRG.dat"
122 docMergeDoc.MailMerge.Destination = 0 'wdSendToNewDocument
'try to avoid reference
124 docMergeDoc.MailMerge.SuppressBlankLines = True
126 docMergeDoc.MailMerge.Execute
'Close docMergeDoc without saving changes.
128 docMergeDoc.Close SaveChanges:=0 'wdDoNotSaveChanges
Exit_CreateLabels:
On Error Resume Next
Exit Sub
Err_CreateLabels:
130 If Err.Number = 4605 Then
132 intErrCtr = intErrCtr + 1
134 If intErrCtr <= 3 Then
135 Sleep (10000) 'Will pause for 10 seconds
136 DoEvents
138 Resume 0
Else
140 strMessage = "Error #" & Err.Number & Err.Description & " at
line " & Erl
142 MsgBox strMessage, vbCritical,
"Project1.frmSaReceive.CreateLabels"
144 Resume Exit_CreateLabels
End If
Else
146 strMessage = "An unexpected error, #" & Err & " : " & Error _
& " has occured at line " & Erl
148 MsgBox strMessage, vbCritical,
"Project1.frmSaReceive.CreateLabels"
150 Resume Exit_CreateLabels
152 Resume 0
End If
End Sub
Private Sub PrintLabels()
On Error GoTo PrintLabels_Err
100 objWord.Documents(1).PrintOut Background:=False
102 While objWord.BackgroundPrintingStatus > 0
104 DoEvents
Wend
105 Set docMergeDoc = Nothing
106 objWord.Quit False
108 Set objWord = Nothing
Exit Sub
PrintLabels_Err:
MsgBox Err.Description & vbCrLf & _
"in Project1.frmSaReceive.PrintLabels " & _
"at line " & Erl
Resume Next
End Sub