使用VBS从记事本复制到Word

Question

我正在尝试创建一个脚本来将 PDF 转换为纯文本，然后将纯文本复制到 Word 中。 （我们在我工作的地方从头开始重新格式化损坏的文档。）我有一个运行良好的脚本，除了一件事：粘贴到 Word 时，它不会粘贴整个文件。对于较长的文件，我只能得到部分文本。

'string to hold file path
Dim strDMM
strDMM = "[path]"

'make this directory if it doesn't exits
On Error Resume Next
MkDir strDMM
On Error GoTo 0

'get the file name to process
Dim TheFile
TheFile = InputBox("What is the file name?" & chr(13) & chr(13) & "(Example: [name].pdf)", "Name of File")

'declare some acrobat variables
Dim AcroXApp
Dim AcroXAVDoc
Dim AcroXPDDoc

'open acrobat
Set AcroXApp = CreateObject("AcroExch.App")
AcroXApp.Hide

'open the document we want
Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
AcroXAVDoc.Open "[path to desktop]" & TheFile, "Acrobat" 'users are instructed to save to the Desktop for ease of access here

'make sure the acrobat window is active
AcroXAVDoc.BringToFront

'I don't know what this does. I copied it from code online.
Set AcroXPDDoc = AcroXAVDoc.GetPDDoc

'activate JavaScript commands w/Acrobat
Dim jsObj
Set jsObj = AcroXPDDoc.GetJSObject

'save the file as plain text
jsObj.SaveAs strDMM & "pdf-plain-text.txt", "com.adobe.acrobat.plain-text"

'close the file and exit acrobat
AcroXAVDoc.Close False
AcroXApp.Hide
AcroXApp.Exit

'declare constants for manipulating the text files
Const ForReading = 1
Const ForWriting = 2

'Create a File System Object
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

'read file and get text
dim objFile
set objFile=objFSO.OpenTextFile( strDMM & TheFile, ForReading)

Dim strText
strText=objFile.ReadAll

'Create a Word Object
Dim objWord
set objWord = CreateObject("Word.Application")

'make Word visible
With objWord
    .Visible = True
End With

'Add method used to create a blank document
Dim objDoc
Set objDoc=objWord.Documents.Add()

'create a shorter variable to pass commands to Word
Dim objSelection
set objSelection=objWord.Selection

'type the read text into Word; this is the part that's failing
objSelection.TypeText strText

objFile.Close

我尝试了多个文件，结果相同。有趣的是，它每次都从文件 A 粘贴相同的材料，但是从文件 B 复制时，它会粘贴不同数量的材料。换句话说，如果 A 在第一次运行时给了我 60 页的 8 页，那么我每次都会得到相同的 8 页。文件 B 可能会给我 14 页，共 60 页，然后每次都给我相同的 14 页。仅当我从 .txt 文件中删除材料时，这才会改变。如果我从 A 中删除几个段落，然后运行脚本，我可能会得到 12 页。然后我每次都得到相同的12个。但是没有模式（我可以辨别）来预测它在哪里切断。

我找不到任何 EOF 字符，当我从记事本读取并写入记事本时，整个内容被完美复制。问题出在转移到 Word 的某个地方。

我有什么遗漏吗？ Word 可以使用 TypeText 写入的字符串的大小是否有限制？ （我认为如果是这样的话，我不会得到不同长度的文档，对吧？如果这是限制，它们不应该都停在 n 个字符处吗？）

我已经阅读了有关允许 VBS 使用剪贴板的其他库的信息，但我完全是个菜鸟，不知道这是否是一个更优雅的解决方案或如何使其工作。我也不确定在我的工作计算机上我是否有必要的访问权限来安装这些库。

感谢任何帮助！

Answer 1

无需将文件读入Word，您可以从磁盘插入文本文件

Dim objWord
'Dim objDoc
Set objWord = CreateObject("Word.Application")

'make Word visible
With objWord
   .Visible = True

   'Add method used to create a blank document
   .Documents.Add
   .Selection.InsertFile FileNameAndPath
End With

Answer 2

您暗示的基本问题是 String 数据类型仅限于65,400 characters。对于未知的文件长度，最好一次读取一行并将其写入 Word。有一个很好的讨论类似here。以下代码应该可以帮助您到达目的地：

'read file and get text
dim objFile
set objFile=objFSO.OpenTextFile( strDMM & TheFile, ForReading)

'Don't do this!
'Dim strText
'strText=objFile.ReadAll

'Create a Word Object
Dim objWord
set objWord = CreateObject("Word.Application")

'make Word visible
With objWord
   .Visible = True
End With

'Add method used to create a blank document
Dim objDoc
Set objDoc=objWord.Documents.Add()

'create a shorter variable to pass commands to Word
Dim objSelection
set objSelection=objWord.Selection

'Read one line at a time from the text file and
'type that line into Word until the end of the file is reached
Dim strLine
Do Until objFile.AtEndOfStream
   strLine = objFile.ReadLine
   objSelection.TypeText strLine
Loop

objFile.Close

希望有帮助！