【发布时间】：2021-01-14 22:07:42
【问题描述】：
我已经构建了一个脚本，借助该脚本，可以将多个 Word 文档的表单域中的内容一个接一个地读出并传输到一个普通的 Excel 表格中。复制功能本身工作，第一个 Word 文件的数据也正确传输，但第二个 Word 文件出现运行时错误 462。 我已经了解到这与 Word 文档的对象关系有关。当第一个 Word 文档关闭时，我的对象显然已被破坏，无法再在第二个文件中正确调用。 特别是，问题似乎与 MSForms.DataObject 有关。我已经阅读了如何通过再次调用对象来解决具有直接 Word 引用的对象的错误，但我不知道如何为 MSForms 对象执行此操作。 有人有建议吗？ 我从下面的脚本中粘贴了相关代码。 如果这看起来像一个糟糕的代码，那是因为我不是程序员，必须谷歌相关的 VBA 知识。我只是想让它运行。
如果你问我为什么使用 MSForms 对象 -> 我需要它来删除人们可能在表单域中输入的段落和类似内容，这样我就可以将所有信息从一个表单域压缩到 Excel 中的一个单元格。
还设置了对 word 和 MSForms 的引用。
Sub DatenProduktion()
'Variablen definieren
'Definitionen fuer Suchpfad
Dim sPfad As String
Dim sOrdner As Integer
Dim strOrd As String
Dim sDateiPr As String
Dim vDateiPr As String
Dim vollPfadPr As String
'Definitionen fuer Zielzellen
Dim startzeile As Integer
Dim startzeilePF As Integer 'Dient zur Bestimmung der ersten Nummer der Maengelberichte
Dim sSpalte As Integer
Dim sZeile As Integer
Dim eSpalte As Integer
Dim eZeile As Integer
'Variablen fuer Uebertragung Inhalte
Dim strDateiPr As String
Dim origstr As String
Dim cleanstr As String
Dim corrstr As String
Dim checkbx As String
Dim clipbrd As MSForms.DataObject
'Variablen fuer Oeffnung Word
Dim wordApp As Word.Application
Dim wDoc As Word.Document
'___________________________________
'Erste freie Zeile finden
Workbooks("Mangelauswertung.xlsm").Worksheets("Produktion").Activate
startzeile = WorksheetFunction.CountA(Range("A:A")) + 4
'___________________________________
'Erste Zielzeile in Produktion
eZeile = startzeile
startzeilePF = startzeile - 5
'___________________________________
'Loop beginnen
Do
'Zuruecksetzen Spalte
eSpalte = 1
'Pfad zur erste noch nicht eingepflegten Word konstruieren
sPfad = "P:\Mängelbericht\Mängelberichte Word\"
sOrdner = startzeilePF
sDateiPr = "Mängelbericht Produktion.docx"
strOrd = CStr(sOrdner)
vollPfadPr = sPfad & strOrd & "_" & sDateiPr
'___________________________________
If Dir(vollPfadPr) <> "" Then
'Namen der Datei in erste Spalte schreiben
vDateiPr = strOrd & "_" & sDateiPr
Workbooks("Mangelauswertung.xlsm").Worksheets("Produktion").Cells(eZeile, eSpalte) = vDateiPr
eSpalte = eSpalte + 1
'Word Datei oeffnen
Set wordApp = CreateObject("word.application")
Set wDoc = wordApp.Documents.Open(vollPfadPr)
wordApp.Visible = True
Set clipbrd = New MSForms.DataObject
'Artikelbezeichnung
wDoc.Bookmarks("Artikelbezeichnung").Range.Copy
clipbrd.GetFromClipboard
origstr = clipbrd.GetText(1)
cleanstr = CleanString(origstr)
corrstr = Replace(cleanstr, Chr(13), Chr(32))
Workbooks("Mangelauswertung.xlsm").Worksheets("Produktion").Cells(eZeile, eSpalte) = corrstr
eSpalte = eSpalte + 1
[...]
'Word-Datei schliessen
Set clipbrd = Nothing
wordApp.Documents.Close
wordApp.Quit
Set wordApp = Nothing
Set wDoc = Nothing
'___________________________________
'Falls keine (neue) Datei gefunden werden kann
Else
Workbooks("Mangelauswertung.xlsm").Worksheets("Produktion").Protect Password:="*****"
Exit Do
End If
eZeile = eZeile + 1
startzeilePF = startzeilePF + 1
Loop
[...]
End Sub
【问题讨论】：
-
据我了解您链接的 makros，它们不适用于我的情况。当我只是从包含文本段落的表单字段中复制范围时，它会被粘贴到 Excel 中的多个单元格中。这对我来说是不可接受的。在将字符串粘贴到 Excel 之前，我必须对其进行修改。这就是我需要 MSForms.DataObject 的原因，我需要了解为什么它在我的情况下会损坏。
-
这两个链接表明您不需要处理每个书签，也不需要使用剪贴板。例如：
origstr = wDoc.Bookmarks("Artikelbezeichnung").Range.Text会给你和origstr = clipbrd.GetText(1)一样的结果 -
我尝试了
origstr = wDoc.Bookmarks("Artikelbezeichnung").Range.Text，但在cleanstr = CleanString(origstr)行上仍然遇到相同的运行时错误。我想我的对象没有为第二个单词文件正确重置，但我不明白为什么。我复制了这些部分以关闭 word 文件，并从 Stackoverflow 上的另一个脚本中将它们设置为空，这似乎可以工作。 -
如果 Word 表单域包含多个段落，您必须在将数据插入 Excel 之前对其进行操作。看我的回答。