Excel VBA在循环中打开多个Word文件

对于这个新手问题，我提前表示歉意——我的大部分VBA经验都是在Excel或Word to Excel中。在本例中，我将从Excel转换为Word。我试图从一些Word表单中捕获一些数据，并将其存储在Excel文件中

现在，我的代码适用于文件夹中的第一个文档，但在那之后，它出现了一个自动化错误“服务器抛出了一个异常”（goo！）

这是我的密码：

Dim objWordApp As Object

strCurFileName = Dir(strFilePath)

Set objWordApp = CreateObject("word.application")
objWordApp.Visible = True

Do While strCurFileName <> ""

    objWordApp.documents.Open strFilePath & strCurFileName
    objWordApp.activedocument.Unprotect password:="testcode"

    {EXCEL PROCESSING HERE}

    strCurFileName = Dir
    objWordApp.activedocument.Close 0

Loop

objWordApp.Quit
Set objWordApp = Nothing

我得到的错误是：

运行时错误-2147417851（80010105） 自动化误差 服务器引发异常。

我在常规word文档（不是我正在处理的文档）上尝试了你的代码，效果很好。我正在运行的文档有表单字段和宏——不确定这是否有区别。我已将Word中的宏安全设置为“低”和“非常高”，以确保其他宏不会干扰

我只是不明白为什么它对第一个医生有效而对下一个不起作用。我甚至克隆了第一个文档，但没有什么不同

---

不过还是没有运气。我能做的唯一一件事就是每次我想打开一个文件时，完全擦除对象并重新创建它们

Set objFolder = FSO.GetFolder(strFilePath)

For Each objFile In objFolder.Files

    Set objWordApp = CreateObject("word.application")
    objWordApp.Visible = True

    If Right(objFile.Name, 4) = ".doc" Then
        Set objWordDoc = objWordApp.documents.Open(Filename:=objFile.Path, ConfirmConversions:=False, _
            ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
            PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
            WritePasswordTemplate:="", Format:=wdOpenFormatAuto)

        [Process DOC]

        objWordDoc.Close 0, 1
    End If

    Set objWordDoc = Nothing
    objWordApp.Quit
    Set objWordApp = Nothing

Next

---

我不知道为什么这样做有效，为什么不起作用。如果我必须走这条路，我可以——它看起来真的很慢，效率很低。这是个坏主意吗？

我将目录更改为FileSystemObject（转到工具\引用并添加Microsoft脚本运行时），并且能够成功打开多个文件。如果您遇到问题，请描述在调试器中看到的错误。此外，如果需要递归到子目录中，则需要对其进行重构

Private mobjWordApp As Word.Application

Sub Test()
  ProcessDirectory "PathName"
End Sub

Property Get WordApp() As Word.Application
  If mobjWordApp Is Nothing Then
    Set mobjWordApp = CreateObject("Word.Application")
    mobjWordApp.Visible = True
  End If
  Set WordApp = mobjWordApp
End Property

Sub CloseWordApp()
  If Not (mobjWordApp Is Nothing) Then
    On Error Resume Next
    mobjWordApp.Quit
    Set mobjWordApp = Nothing
  End If
End Sub

Function GetWordDocument(FileName As String) As Word.Document
    On Error Resume Next
    Set GetWordDocument = WordApp.Documents.Open(FileName)
    If Err.Number = &H80010105 Then
      CloseWordApp
      On Error GoTo 0
      Set GetWordDocument = WordApp.Documents.Open(FileName)
    End If
End Function

Sub ProcessDirectory(PathName As String)
  Dim fso As New FileSystemObject
  Dim objFile As File
  Dim objFolder As Folder
  Dim objWordDoc As Object

  On Error Goto Err_Handler

  Set objFolder = fso.GetFolder(PathName)
  For Each objFile In objFolder.Files
    If StrComp(Right(objFile.Name, 4), ".doc", vbTextCompare) = 0 Then
      Set objWordDoc = GetWordDocument(objFile.Path)
      ' objWordDoc.Unprotect Password:="testcode" ' Need to check if it has Password?
      ProcessDocument objWordDoc
      objWordDoc.Close 0, 1
      Set objWordDoc = Nothing
    End If
  Next

Exit_Handler:
  CloseWordApp
  Exit Sub

Err_Handler:
  MsgBox "Error " & Err.Number & ": " & Err.Description
  Resume Exit_Handler
  'Resume Next ' or as above
End Sub

Sub ProcessDocument(objWordDoc As Document)
  '{EXCEL PROCESSING HERE}'
End Sub

编辑：我添加了一些错误处理和一些重构，尽管还有很多重构可以完成

你打开的文件一定有什么特别之处。您可以尝试使用不同的参数打开文档，例如：

Set objWordDoc = objWordApp.Documents.Open( _
  FileName:=objFile.Path, ReadOnly:=True)

您可能需要添加Microsoft Word作为参考，如果这样做，则开始使用Word常量（wdDoNotSaveChanges等）。查看文档帮助。打开并测试不同的参数

另外，在调试期间使用上下文菜单中的“Set Next Statement”（设置下一个语句），可以跳过第一个文档，直接打开第二个文档，查看是否存在问题

编辑：我已经更改了代码，如果出现您描述的自动化错误，请关闭并重新打开Word。您可能需要调整错误号，或者在出现任何错误时关闭Word（如果错误号为0，则…）

同样，您的文档（宏、保护等）必须有一些特别之处，因为这段代码适用于我尝试过的测试用例。您是否尝试过以与脚本相同的顺序在Word中手动打开文档，更新与流程脚本类似的信息，然后关闭文档以查看Word是否有任何异常行为

关闭这个词。应用程序不会造成任何伤害，但它显然会大大减慢速度。

你说的“爆炸”是什么意思？有错误信息吗？

Set objWordDoc = objWordApp.Documents.Open( _
  FileName:=objFile.Path, ReadOnly:=True)