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

person user1020971    schedule 27.11.2012    source источник


Ответы (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 документов / секунду на большинстве обычных персональных компьютеров.

person Alexandre    schedule 29.05.2013