VBA生成Word第二次运行就会报错：运行时错误'462’：远程服务器不存在或不可用

呓语清辰

写了一个将excel中数据导出到word的程序，第一运行正常。但是第二次运行就会报错。请大神们帮忙看看代码需要怎么处理下？

1. 
   
2. 
   
3. Sub EXCEL转Word()
   
4. 
   
5. Application.ScreenUpdating = False     '关闭屏幕刷新
   
6. Application.DisplayAlerts = False     '关闭提示
   
7.      ' On Error Resume Next  '忽略错误
   
8. 
   
9. Dim wApp As Word.Application
   
10. Dim wDoc As Word.Document
    
11. 
    
12. Set wApp = CreateObject("Word.Application")
    
13. 
    
14. Dim rownum, colnum, i, j, k, l, tabnum, icon As Integer
    
15. Dim val1, val2, oldval, doctitile As String
    
16. 
    
17. doctitile = Sheet9.Range("B2").Value & "工艺单元设计方案"
    
18. 
    
19. wApp.Visible = True
    
20. 
    
21. Set wDoc = wApp.Documents.Add(Template:=ThisWorkbook.Path & "" & "工艺单体设计模板.dotx", NewTemplate:=False, DocumentType:=0)
    
22. 
    
23. 
    
24. Excel.Application.Sheets("设备选型表").Activate  '切换当前电子表格的表bell为当前激活表
    
25. 
    
26. 
    
27. row1 = Range("B65535").End(xlUp).Row
    
28. 
    
29. 
    
30. For i = 3 To row1
    
31.     val1 = Excel.Application.Sheets("设备选型表").Range("a" & i)
    
32.   
    
33.      
    
34.      
    
35.      '读取工艺功能描述
    
36.      
    
37.      Dim find1 As String
    
38.      Dim rownum2, lnum1 As Integer
    
39.      
    
40.      rownum2 = Sheet15.[A65536].End(xlUp).Row
    
41.      
    
42.      For lnum1 = 3 To rownum2
    
43.         
    
44.         If Excel.Application.Sheets("工艺单元功能描述").Range("A" & lnum1).Value = val1 Then
    
45.         
    
46.         find1 = Excel.Application.Sheets("工艺单元功能描述").Range("B" & lnum1).Value
    
47.         
    
48.         Exit For
    
49.         
    
50.         End If
    
51.      
    
52.      Next
    
53.      
    
54.      
    
55.      '读取构建筑物部分
    
56.      
    
57.      Dim find2 As String
    
58.      
    
59.      Dim totalrow2, lnum2, findnum As Integer
    
60.      
    
61.      totalrow2 = Sheet4.[B65536].End(xlUp).Row
    
62.         
    
63.       For lnum2 = 3 To totalrow2
    
64.         
    
65.             If Excel.Application.Sheets("6-1 土建投资").Range("B" & lnum2).Value = val1 Then
    
66.                
    
67.                findnum = lnum2
    
68.             Exit For
    
69.             
    
70.             End If
    
71.         Next
    
72.      
    
73.      '读取工艺设计参数部分
    
74.      
    
75.      Dim find3 As String
    
76.      
    
77.      Dim totalrow3, lnum3, findnum2, totalcol As Integer
    
78.      
    
79.      totalcol = Sheets("工艺单元参数设计").Range("ZZ" & i).End(xlToLeft).Column
    
80.      
    
81.      totalrow3 = Sheet16.[A65536].End(xlUp).Row
    
82.          
    
83.          
    
84.       For lnum3 = 3 To totalrow3
    
85.         
    
86.             If Excel.Application.Sheets("工艺单元参数设计").Range("A" & lnum3).Value = val1 Then
    
87.                
    
88.                findnum2 = lnum3
    
89.             Exit For
    
90.             
    
91.             End If
    
92.         Next
    
93.      
    
94.      
    
95.      '读取设备名称部分
    
96.      
    
97.      If val1 <> oldval Then
    
98.      
    
99.          
    
100.         With wApp.Application
     
101.         
     
102.         
     
103.         .Activate                                      '激活WORD软件
     
104.         .Selection.EndKey Unit:=wdStory
     
105.          
     
106.         
     
107.          .Selection.Style = .ActiveDocument.Styles("标题 2")
     
108.          
     
109.          .Selection.TypeText Text:=val1
     
110.          
     
111.          .Selection.TypeParagraph
     
112.          
     
113.          
     
114.          .Selection.Style = .ActiveDocument.Styles("标题 3")
     
115.          .Selection.TypeText Text:="功能描述"
     
116.          .Selection.TypeParagraph
     
117.          .Selection.TypeText Text:=find1
     
118.          .Selection.TypeParagraph
     
119.          
     
120.          
     
121.          
     
122.          .Selection.Style = .ActiveDocument.Styles("标题 3")
     
123.          .Selection.TypeText Text:="构建筑物参数"
     
124.          .Selection.TypeParagraph
     
125.          
     
126.           Sheets("6-1 土建投资").Range("C" & findnum & ":D" & findnum).Copy
     
127.           .Activate
     
128.           .Selection.PasteExcelTable False, False, False
     
129.          
     
130.           Sheets("6-1 土建投资").Range("J" & findnum & ":K" & findnum).Copy
     
131.           .Activate
     
132.           .Selection.PasteExcelTable False, False, False
     
133.           .Selection.MoveLeft Unit:=wdCharacter, Count:=2
     
134.           .Selection.TypeText Text:=Sheets("6-1 土建投资").Range("L" & findnum).Value
     
135.           .Selection.MoveDown Unit:=wdLine, Count:=1
     
136.          
     
137.           Sheets("6-1 土建投资").Range("O" & findnum & ":P" & findnum).Copy
     
138.           .Activate
     
139.           .Selection.PasteExcelTable False, False, False
     
140.               
     
141.          
     
142.          
     
143.          
     
144.          .Selection.Style = .ActiveDocument.Styles("标题 3")
     
145.          .Selection.TypeText Text:="工艺技术参数"
     
146.          .Selection.TypeParagraph
     
147.       
     
148.          For k = 2 To totalcol Step 2
     
149.            
     
150.            Excel.Application.Sheets("工艺单元参数设计").Activate
     
151.            
     
152.            Sheets("工艺单元参数设计").Range(Cells(i, k), Cells(i, k + 1)).Copy
     
153.           .Activate
     
154.           .Selection.PasteExcelTable False, False, False
     
155.             
     
156.          Next
     
157.       
     
158.               
     
159.          
     
160.          
     
161.          
     
162.          .Selection.Style = .ActiveDocument.Styles("标题 3")
     
163.          .Selection.TypeText Text:="主要设备参数"
     
164.          .Selection.TypeParagraph
     
165.       
     
166.       
     
167.       
     
168.       
     
169.        val2 = Excel.Application.Sheets("设备选型表").Range("c" & i)
     
170.       
     
171.         j = 1
     
172.       
     
173.        colnum = Sheets("设备选型表").Range("ZZ" & i).End(xlToLeft).Column - 6
     
174.                     
     
175.               
     
176.        .Selection.TypeText Text:="（" & j & "）" & val2 & "               数量：" & Sheets("设备选型表").Range("E" & i).Value & Sheets("设备选型表").Range("F" & i).Value  '插入设备名称
     
177.       
     
178.        .Selection.TypeParagraph
     
179.       
     
180.       
     
181.         
     
182.                
     
183.           For m = 7 To colnum + 6 Step 2
     
184.            
     
185.            Excel.Application.Sheets("设备选型表").Activate
     
186.                      
     
187.            Sheets("设备选型表").Range(Cells(i, m), Cells(i, m + 1)).Copy
     
188.            
     
189.          
     
190.           .Activate
     
191.           .Selection.PasteExcelTable False, False, False
     
192.                
     
193.         
     
194.         Next
     
195.       
     
196.         End With
     
197.       
     
198.       
     
199.       
     
200.        Else
     
201.       
     
202.       
     
203.        With wApp.Application
     
204.       
     
205.        .Activate                                    '激活WORD软件
     
206.      
     
207.        .Selection.EndKey Unit:=wdStory                '定位至末尾行
     
208.      
     
209.        val2 = Excel.Application.Sheets("设备选型表").Range("c" & i)
     
210.       
     
211.        wApp.ActiveWindow.Selection.TypeText Text:="（" & j & "）" & val2 & "               数量：" & Range("E" & i).Value & Range("F" & i).Value    '插入设备名称
     
212.        .Selection.TypeParagraph
     
213.       
     
214.        End With
     
215.       
     
216.       ' Excel.Application.Sheets("设备选型表").Activate
     
217.       
     
218.        colnum = Range("ZZ" & i).End(xlToLeft).Column - 6
     
219.       
     
220.        For k = 7 To colnum + 6 Step 2
     
221.                   
     
222.                      
     
223.            Sheets("设备选型表").Range(Cells(i, k), Cells(i, k + 1)).Copy
     
224.            
     
225.            wApp.Application.Selection.PasteExcelTable False, False, False
     
226.       
     
227.        Next
     
228.      End If
     
229.       
     
230.       oldval = val1
     
231.       
     
232.       j = j + 1
     
233.    
     
234.      Next
     
235.      
     
236.    
     
237.     '—————— 调整表格格式————————
     
238. 
     
239.   
     
240.      Dim mytable As Table
     
241.      
     
242. 
     
243.      For Each mytable In wDoc.Tables
     
244. 
     
245.      With mytable
     
246. 
     
247.          .Style = "Sheet Style"
     
248. 
     

复制代码

呓语清辰

代码太长了，最后没粘出来，这是后面的代码部分，也是出错的地方



'—————— 调整表格格式————————

  
     Dim mytable As Table
     

     For Each mytable In wDoc.Tables

     With mytable

         .Style = "Sheet Style"
         .Rows.LeftIndent = CentimetersToPoints(1)

         .Rows.Height = CentimetersToPoints(0.75)

         .PreferredWidth = CentimetersToPoints(13.5)

         .Columns(1).PreferredWidthType = wdPreferredWidthPercent
         .Columns(1).PreferredWidth = 20

     With .Range

        With .Font '字体格式
                    .Name = "宋体"
                    .Name = "Times New Roman"
                    .Color = wdColorAutomatic '自动字体颜色
                    .Size = 12
                    .Kerning = 0
                    .DisableCharacterSpaceGrid = True
                End With


        With .ParagraphFormat '段落格式
                    .CharacterUnitFirstLineIndent = 0 '取消首行缩进
                    .FirstLineIndent = CentimetersToPoints(0) '取消首行缩进
                    .LineSpacingRule = wdLineSpaceSingle '单倍行距  wdLineSpaceExactly '行距固定值
                    '.LineSpacing = 20 '设置行间距为20磅，配合行距固定值
                    .Alignment = wdAlignParagraphCenter '单元格水平居中
                    .AutoAdjustRightIndent = False
                    .DisableLineHeightGrid = True
        End With

        .Cells.VerticalAlignment = wdCellAlignVerticalCenter  '单元格垂直居中

        End With

     End With

     Next

     
     
     Excel.Application.Sheets("设备选型表").Range("a3").Select
     Application.CutCopyMode = False    '清空剪贴板
     Application.ScreenUpdating = True

     wApp.DisplayAlerts = True
     
            
      '—————— 保存文档————————
            
            
      wDoc.SaveAs2 ThisWorkbook.Path & "\" & doctitile & Format(Date, "yyyyMMDD") & ".docx"

   
     wApp.Quit
    ' Set wDoc = Nothing
   


End Sub

losenoisy

哥们，这个问题解决了吗。我看外网一些兄弟说时with部分的问题

adam666888

我也遇到类似问题，问题出在了系统第二次搞不清是要word干活，还是excel干活，所以需要在Excel VBA里用word.Documents.Application+ActiveDocument.Tables(1).Range.。。。
不晓得是否能帮到你

ootoo001

我也出现一样的问题，怎么解决

闻启学

楼主  上附件


Excel.Application.Sheets("6-1 土建投资")  这个模式错了 还欠工作薄名称   检查一下