运行时错误462：远程服务器机器不存在或不可用“在第二次迭代
我知道这是非常接近其他问题，但我没有通过其他解决scheme，这就是为什么我现在发布我的问题，以确定我的问题。 我已经在代码中指出第二次迭代期间popup错误的地方。 这里也是一个类似问题的例子。
Sub ExcelToWOrdCopy() Dim objWord As Word.Application LR = Cells(Rows.Count, 1).End(xlUp).Row For x = 3 To LR Call PrintScreen 'Print screen set in a module and works fine Set objWord = CreateObject("Word.Application") objWord.Documents.Open ("C:\Users\a222012\Desktop\EDD Results File.docx") objWord.Visible = True objWord.ActiveDocument.Bookmarks("ScreenShot").Range.Paste 'Bookmarks have been placed in above word document. ActiveSheet.Range("C2:L2").Copy objWord.ActiveDocument.Bookmarks("LinkName").Range.Paste objWord.ActiveDocument.Tables(1).AutoFitBehavior (wdAutoFitWindow) 'Error on next line during 2nd iteration objWord.ActiveDocument.Tables(1).Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle objWord.ActiveDocument.Tables(1).Borders(wdBorderBottom).LineWidth = Options.DefaultBorderLineWidth objWord.ActiveDocument.Tables(1).Borders(wdBorderBottom).Color = Options.DefaultBorderColor objWord.ActiveDocument.Tables(1).Borders(wdBorderRight).LineStyle = Options.DefaultBorderLineStyle objWord.ActiveDocument.Tables(1).Borders(wdBorderRight).LineWidth = Options.DefaultBorderLineWidth objWord.ActiveDocument.Tables(1).Borders(wdBorderRight).Color = Options.DefaultBorderColor ActiveSheet.Hyperlinks.Add Range(Cells(x, 3), Cells(x, 12)), Text Range(Cells(x, 3), Cells(x, 12)).Copy objWord.Visible = True objWord.ActiveDocument.Bookmarks("Links").Range.Paste objWord.ActiveDocument.Tables(2).AutoFitBehavior (wdAutoFitWindow) objWord.ActiveDocument.SaveAs2 ("C:\Users\a222012\Desktop\EDD\" & (Cells(3, 1) & " - " & Cells(x, 1))) objWord.Quit Next x Set objWord = Nothing End Sub 正如在其他答复和评论中所说，
在您的循环中创build/使用Word的一个实例会更好（也更稳定）。
我还添加了几个With来提高代码的可读性和性能：
Sub ExcelToWOrdCopy() Dim objWord As Word.Application Dim oDoc As Word.Document Dim wS As Excel.Worksheet '''Change sheet's name below Set wS = ThisWorkbook.Sheets("Sheet1") '''This will use existing instance of Word if there is one, or create a new one On Error Resume Next Set objWord = CreateObject("Word.Application") On Error GoTo 0 If objWord Is Nothing Then Set objWord = CreateObject("Word.Application") objWord.Visible = True LR = wS.Cells(wS.Rows.Count, 1).End(xlUp).Row For x = 3 To LR Call PrintScreen 'Print screen set in a module and works fine Set oDoc = objWord.Documents.Open("C:\Users\a222012\Desktop\EDD Results File.docx") With oDoc .Bookmarks("ScreenShot").Range.Paste 'Bookmarks have been placed in above word document. wS.Range("C2:L2").Copy objWord.Visible = True .Bookmarks("LinkName").Range.Paste With .Tables(1) .Tables(1).AutoFitBehavior (wdAutoFitWindow) With .Borders(wdBorderBottom) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With '.Borders(wdBorderBottom) With .Borders(wdBorderRight) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With '.Borders(wdBorderRight) End With '.Tables(1) wS.Hyperlinks.Add Range(wS.Cells(x, 3), wS.Cells(x, 12)), Text wS.Range(wS.Cells(x, 3), wS.Cells(x, 12)).Copy objWord.Visible = True .Bookmarks("Links").Range.Paste .Tables(2).AutoFitBehavior (wdAutoFitWindow) DoEvents .SaveAs2 ("C:\Users\a222012\Desktop\EDD\" & (Cells(3, 1) & " - " & Cells(x, 1))) End With 'oDoc Next x objWord.Quit Set objWord = Nothing End Sub