ntman2
07-16-2014, 09:54 AM
Hello,
[Using MS Word 2010]
I have a macro that converts a Word document from docx format to txt format. However there are some documents that stop during conversion with the following notification: "The document may contain text content that will be lost upon conversion to the chosen encoding. To preserve this content , click No to exit this dialog box,and then choose another encoding that supports the languages in this document.
Do you want to continue saving the document? Yes/No" [An attachment with a screen shot of the exact message is attached.]
Of course I want to continue to save the document as txt so I have to click the Yes button. I am converting hundreds of documents (docx) to text and want the macro to intercept this message and tell Word 'Yes" without my intervention. Can anyone tell me the VBA code needed to accomplish this and where in my macro does it need to go? I am a complete novice to VBA. I found the following VBA code on the Internet and it works fine except for what I just indicated about the Word message. Here is the code:
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
Thank you for your help.
ntman2
[Using MS Word 2010]
I have a macro that converts a Word document from docx format to txt format. However there are some documents that stop during conversion with the following notification: "The document may contain text content that will be lost upon conversion to the chosen encoding. To preserve this content , click No to exit this dialog box,and then choose another encoding that supports the languages in this document.
Do you want to continue saving the document? Yes/No" [An attachment with a screen shot of the exact message is attached.]
Of course I want to continue to save the document as txt so I have to click the Yes button. I am converting hundreds of documents (docx) to text and want the macro to intercept this message and tell Word 'Yes" without my intervention. Can anyone tell me the VBA code needed to accomplish this and where in my macro does it need to go? I am a complete novice to VBA. I found the following VBA code on the Internet and it works fine except for what I just indicated about the Word message. Here is the code:
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
Thank you for your help.
ntman2