MS Word VBA docx to txt消息陷阱代码

Question

使用MS Word 2010

我有一个宏，可以将Word文档从docx格式转换为txt格式。但是，有些文档在转换过程中停止，并显示以下通知：“文档可能包含在转换为所选编码时丢失的文本内容。若要保留此内容，请单击”否“退出此对话框，然后选择支持此文档中的语言的其他编码。是否要继续保存文档?是/否”当然，我希望继续将文档另存为txt，因此必须单击“是”按钮。我正在将成百上千的文档(docx)转换为文本，并希望宏能在没有我干预的情况下截获此消息并说“是”。谁能告诉我完成此操作所需的VBA代码，以及它需要放到我的宏中的何处?我完全是VBA的新手。我在Internet上找到了以下VBA代码，除了我刚才提到的关于Word message的内容之外，它工作得很好。下面是代码：

Sub ChangDocsToTxtOrRTForHTML()
'with export to PDF in word 2007
Dim fs As Object
Dim oFolder As Object
Dim tFolder As Object
Dim oFile As Object
Dim strDocName As String
Dim intPos As Integer
Dim locFolder As String
Dim fileType As String
On Error Resume Next
locFolder = InputBox("Enter the folder path do DOCs", "File Conversion", "C:\myDocs")
Select Case Application.Version
Case Is < 12
Do
fileType = UCase(InputBox("Change DOC to TXT, RTF, HTML", "File Conversion", "TXT"))
Loop Until (fileType = "TXT" Or fileType = "RTF" Or fileType = "HTML")
Case Is >= 12
Do
fileType = UCase(InputBox("Change DOC to TXT, RTF, HTML, or PDF(2007+ only)", "File  Conversion", "TXT"))
Loop Until (fileType = "TXT" Or fileType = "RTF" Or fileType = "HTML" Or fileType = "PDF")
End Select
Application.ScreenUpdating = False
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(locFolder)
Set tFolder = fs.CreateFolder(locFolder & "Converted")
Set tFolder = fs.GetFolder(locFolder & "Converted")
For Each oFile In oFolder.Files
Dim d As Document
Set d = Application.Documents.Open(oFile.Path)
strDocName = ActiveDocument.Name
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
ChangeFileOpenDirectory tFolder
Select Case fileType
Case Is = "TXT"
strDocName = strDocName & ".txt"
ActiveDocument.SaveAs FileName:=strDocName, Fileformat:=wdFormatText
Case Is = "RTF"
strDocName = strDocName & ".rtf"
ActiveDocument.SaveAs FileName:=strDocName, Fileformat:=wdFormatRTF
Case Is = "HTML"
strDocName = strDocName & ".html"
ActiveDocument.SaveAs FileName:=strDocName, Fileformat:=wdFormatHTML
Case Is = "PDF"
strDocName = strDocName & ".pdf"
'*** Word 2007 users - remove the apostrophe at the start of the next line ***
'ActiveDocument.ExportAsFixedFormat OutputFileName:=strDocName,    ExportFormat:=wdExportFormatPDF
End Select
d.Close
ChangeFileOpenDirectory oFolder
Next oFile
Application.ScreenUpdating = True
End Sub
Sub ConvertFiles()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.txt", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
Format:=wdOpenFormatEncodedText, Encoding:=msoEncodingUTF8, _
AddToRecentFiles:=False, Visible:=False)
wdDoc.SaveAs2 FileName:=strFolder & "\" & Replace(strFile, ".txt", ".docx"), _
Fileformat:=wdFormatXMLDocument, AddToRecentFiles:=False
wdDoc.Close SaveChanges:=False
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder",  0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

谢谢你的帮助。ntman2

Answer 1

对于文本文件，Word可以对另存为文件使用不同的编码方案，从而避免生成此警告。尝试：

ActiveDocument.SaveAs _
   FileName:=strDocName, _
   Fileformat:=wdFormatText, _
   Encoding:=msoEncodingUnicodeLittleEndian

而不是：

ActiveDocument.SaveAs FileName:=strDocName, Fileformat:=wdFormatText