使用VBA运行时错误462在Excel中合并Docx文件远程服务器计算机，然后文件损坏

Question

Help! There has been a lot of posts with regards to this subject, and I have tried most of them but still to no avail.

Basically I am just trying to merge the contents of docx files with the same names in a specified folder. Every file contains an image, 1file:1image. I am getting an error when I run the code the first time (Error 462 Remote Server Machine does not exist or is unavailable) and it points at

ActiveDocument.Range.InsertFile Filename:=myDir & nextFile

Anybody knows how to work around this? Please. Here is my code:

Sub Merger()
    Dim firstFileStr As String
    Dim firstFile As String
    Dim nextFileStr As String
    Dim nextFile As String

    Dim xFlag As Boolean
    Dim myDir As String

    myDir = "C:\Users\User\Desktop\MergeFolder\"
    For iCtr = 1 To getRowCount
        firstFileStr = Sheet1.Cells(iCtr, 3).Value
        firstFile = Sheet1.Cells(iCtr, 1).Value

        xFlag = True
        Dim jCtr As Integer
        jCtr = 1

        Do While (xFlag)
            nextFileStr = Sheet1.Cells(iCtr + jCtr, 3).Value
            nextFile = Sheet1.Cells(iCtr + jCtr, 1).Value

            If StrComp(firstFileStr, nextFileStr, vbTextCompare) = 0 Then
                Dim WordApp As Word.Application 'word application
                Dim WordDoc As Word.Document    'word document

                If Not WordApp Is Nothing Then
                    WordApp.Quit
                End If

                Set WordApp = New Word.Application
                Set WordDoc = WordApp.Documents.Open(myDir & firstFile, ConfirmConversions = False, ReadOnly = False)

                Application.ScreenUpdating = False

                ActiveDocument.Range.InsertFile Filename:=myDir & nextFile

                WordDoc.SaveAs Filename:=myDir & "merged " & firstFileStr, FileFormat:=wdFormatDocument
                WordDoc.Close
                WordApp.Quit

                Set WordDoc = Nothing
                Set WordApp = Nothing

                xFlag = True
                jCtr = jCtr + 1
            Else
                xFlag = False
            End If
        Loop
    Next
End Sub

The function getRowCount is just to return the number or rows Sheet1 contains. Here,

Function getRowCount() As Integer
    Dim rowCount As Integer
    rowCount = 0

    Range("A1").Select
    ' Set Do loop to stop when an empty cell is reached.
    Do While Not IsEmpty(ActiveCell)
        rowCount = rowCount + 1
        ' Step down 1 row from present location.
        ActiveCell.Offset(1, 0).Select
    Loop
    getRowCount = rowCount

End Function

Now when I run the code immediately after the previous error and without killing MS Word processes at the Task Manager, I get another error Runtime Error 5792 The file appears to be corrupted. Inspecting the newly created files, it seems that the code

ActiveDocument.Range.InsertFile Filename:=myDir & nextFile

didn't work at all. The excel file looks like (Column B is empty)

Column    A         B     C 
alpha - 1.docx          alpha  
alpha -2.docx           alpha  
alpha - 3.docx          alpha  
alpha - 4.docx          alpha  
bravo - 1.docx          bravo  
bravo - 5.docx          bravo  
charlie- 2.docx         charlie  
delta - 3.docx          delta  
delta - 5.docx          delta  
epsilon - 9.docx        epsilon  
foxtrot - 1.docx        foxtrot         
merger.xlsm             0 
~$merger.xlsm             0

It's supposed to merge all " Alpha - *.docx " to " Alpha - 1.docx ", bravo - 5.docx to bravo - 1.docx, etc.

Answer 1

I've done some research and the problem is that you have the word file open read only. Make sure that the word doc is closed and that you have access to open it with write permissions.

You can test to see if it is open readonly by adding a messagebox sometime after you open the file, but before you try to paste stuff in it:

MsgBox Worddoc.readonly