MS Word VBA docx到短信陷阱代码

时间:2014-07-17 01:58:04

标签: vba ms-word

[使用MS Word 2010]

我有一个宏将Word文档从docx格式转换为txt格式。但是,有些文档在转换过程中会停止并显示以下通知:"文档可能包含在转换为所选编码时将丢失的文本内容。若要保留此内容,请单击“否”退出此对话框,然后选择支持本文档中的语言的其他编码。 要继续保存文档吗?是/否" 当然我想继续将文档保存为txt,所以我必须单击Yes按钮。我正在将数百个文档(docx)转换为文本,并希望宏拦截此消息并告诉Word'是"没有我的干预。任何人都可以告诉我完成这个所需的VBA代码以及我的宏需要去哪里?我是VBA的新手。我在Internet上找到了以下VBA代码,除了我刚刚指出的有关Word消息的内容外,它工作正常。这是代码:

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

1 个答案:

答案 0 :(得分:0)

对于文本文件,Word可以对保存的文件使用不同的编码方案,以避免生成此警告。尝试:

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

而不是:

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