vb6实时错误462，远程服务器不存在或不可用？

Question

Private Sub Command1_Click()
Dim xlApp As New excel.Application '定义并创建EXCEL对象
Dim xlBook As New excel.Workbook '创建工作簿
xlApp.DisplayAlerts = False
xlApp.Visible = True '让Excel可见
Set xlBook = xlApp.Workbooks.Open(App.Path & "/do.xls") '打开Excel模板
With xlBook.ActiveSheet
.Range("b4") = Text1.Text '填充第一行第一列的值
.Range("i4") = Text2.Text ' 填充其他行列的值，具体的填充位置得根据模板来做
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=1234 '表格设定密Set excel_Book = excel_App.Workbooks.Open(App.Path & "\dot.XLS")
ChDir "D:\评定表牧牛科技"
ActiveWorkbook.SaveAs FileName:="D:\评定表牧牛科技\" & Text1.Text & Text2.Text & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Shell "taskkill /f /im excel.exe" '关闭excel所有应用
End Sub
Private Sub Command2_Click()
Form1.Show
Unload Form2
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '改代码既可以让叉叉失效，又可以执行unload命令。不用的话，不能执行。
Cancel = UnloadMode = 0 '改代码既可以让叉叉失效，又可以执行unload命令。不用的话，不能执行。
End Sub

Private Sub Combo1_Click() '下拉菜单控制文本数据，text属性enable确定能不能手动输入
Select Case Combo1.Text
Case "好"
Text1.Text = "3"
Case "差"
Text1.Text = "1"

Case "行"
Text1.Text = "2"
End Select
Text3 = Val(Text1) + Val(Text2) '计算公式放这里面的原因是，点击便可以触发
End Sub

Private Sub Combo2_Click() '下拉菜单控制文本数据，text属性enable确定能不能手动输入
Select Case Combo2.Text
Case "啊"
Text2.Text = "13"
Case "哇"
Text2.Text = "21"

Case "的"
Text2.Text = "32"
End Select
Text3 = Val(Text1) + Val(Text2) '计算公式放这里面的原因是，点击便可以触发
Dim a As Long
a = Text3.Text
If 14 < a And a < 30 Then
Text4.Text = "不行"
Else
End If
Dim b As Long
b = Text3.Text
If 30 < b And b < 36 Then
Text4.Text = "很好"
Else
End If
End Sub

程序运行一次没有问题。如果不全部退出程序就运行第二次便会提示“实时错误462，远程服务器不存在或不可用”全部退出程序，再运行，第一次还是正常。运行第二次又会那样子！

Answer 1

Private Sub Command1_Click()
Dim xlApp As New excel.Application '定义并创建EXCEL对象
Dim xlBook As New excel.Workbook '创建工作簿
xlApp.DisplayAlerts = False
xlApp.Visible = True '让Excel可见
Set xlBook = xlApp.Workbooks.Open(App.Path & "/do.xls") '打开Excel模板
With xlBook.ActiveSheet
.Range("b4") = Text1.Text '填充第一行第一列的值
.Range("i4") = Text2.Text ' 填充其他行列的值，具体的填充位置得根据模板来做
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=1234
End With
xlBook.SaveAs FileName:="D:\评定表牧牛科技\" & Text1.Text & Text2.Text & ".xlsx", FileFormat:= xlOpenXMLWorkbook, CreateBackup:=False
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub