在第2次迭代期间，“运行时错误462:远程服务器机器不存在或不可用”

I am aware this is very close to other questions but I have failed to identify my problem through other posted solutions which is why I am posting it now. I have indicated in the code where the error pops up during the 2nd iteration. Here is an example of a similar question as well.

我知道这与其他问题非常接近，但是我没有通过其他发布的解决方案发现我的问题，这就是我现在发布它的原因。我在代码中指出了在第二次迭代中出现错误的地方。这里还有一个类似问题的例子。

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

1 个解决方案

#1

As said in the other answer and in comments,
it is better (and more stable) to create/use only ONE instance of Word in your loop.

正如在另一个答案和注释中所说，在循环中只创建/使用一个Word实例是更好的(而且更稳定)。

I've also added a few With to improve code readability and performances :

我还添加了一些提高代码可读性和性能的方法:

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

#1