VBA, чтобы открыть.doc в режиме "Восстановить текст из любого файла"
Я пытаюсь преобразовать многие старые файлы.DOC в формат PDF или RTF. До сих пор я нашел тот, который выполняет последнее (преобразование в RTF), однако форматирование из старого приложения Word все еще присутствует в документах. Если вы откроете Microsoft Word (я использую 2010) и нажмете "Файл"> "Открыть", появится раскрывающееся меню, в котором можно выбрать "Восстановить текст из любого файла (.)". Можно ли использовать это в процессе преобразования для фильтрации данных форматирования в документах.DOC? Ниже приведено несколько примеров скрипта, который я сейчас пытаюсь изменить:
Это сработало, хотя кажется, что он добавляет только.rtf в конец файла, а не изменяет формат:
Sub SaveAllAsDOCX()
Dim strFilename As String
Dim strDocName As String
Dim strPath As String
Dim oDoc As Document
Dim fDialog As FileDialog
Dim intPos As Integer
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
..InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFilename = Dir$(strPath & "*.doc")
While Len(strFilename) <> 0
Set oDoc = Documents.Open(strPath & strFilename)
strDocName = ActiveDocument.FullName
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".docx"
oDoc.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatDocumentDefault
oDoc.Close SaveChanges:=wdDoNotSaveChanges
strFilename = Dir$()
Wend
End Sub
Этот не был успешным в каких-либо преобразованиях:
Option Explicit
Sub ChangeDocsToTxtOrRTFOrHTML()
'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 to 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:=wdFormatFilteredHTML
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
1 ответ
Я расскажу об одном способе, используя скрипт VBA, делать то, что вы хотите, без необходимости использовать встроенную в Word функциональность режима "Восстановить текст из любого файла".
Он преобразует каждый.doc/.docx в одном каталоге в.txt, но может использоваться для преобразования в любой другой формат, поддерживаемый родительским приложением (я тестировал в Word 2010). Следующее:
'------------ VBA script start -------------
Sub one1()
Set fs = CreateObject("Scripting.FileSystemObject")
Set list1 = fs.GetFolder(ActiveDocument.Path)
For Each fl In list1.files
If InStr(fl.Type, "Word") >= 1 And Not fl.Path = ActiveDocument.Path & "\" & ActiveDocument.Name Then
Set wordapp = CreateObject("word.Application")
Set Doc1 = wordapp.Documents.Open(fl.Path)
'wordapp.Visible = True
Doc1.SaveAs2 FileName:=fl.Name & ".txt", fileformat:=wdFormatText
wordapp.Quit
End If
Next
End Sub
'------------ VBA script start -------------
чтобы сохранить как PDF, используйте
Doc1.SaveAs2 FileName:=fl.Name & ".pdf", fileformat:=wdFormatPDF
вместо
чтобы сохранить как RTF, используйте
Doc1.SaveAs2 FileName:=fl.Name & ".rtf", fileformat:=wdFormatRTF
вместо
или, скажем, HTML:
Doc1.SaveAs2 FileName:=fl.Name & ".html", fileformat:=wdFormatHTML
и так далее.
Некоторые недостатки, которые я не потрудился проверить, потому что они безобидны:
в конце выполнения появляется сообщение об ошибке, но без каких-либо последствий.
он пытается открыть себя, так как это скрипт VBA внутри самого документа, и это скрипт открывания документа. И тогда вам придется поручить "ему" открывать его только для чтения вручную, когда появляется сообщение.
он сохранит все документы в C:\users\username\Documents вместо того, из которого он был выполнен, что было бы лучше в большинстве случаев.
медленный процесс, ожидайте скорость 2-3 документа / секунду в большинстве обычных персональных компьютеров.