Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
giaber
7 / 2 / 0
Регистрация: 16.09.2014
Сообщений: 187
1

Конвертация MHT в DOCX - пакетно не получается

16.10.2018, 20:49. Просмотров 455. Ответов 8
Метки нет (Все метки)

Здравствуйте!
За годы у меня на компе накопилось почти 15 тысяч файлов в формате mht. После конвертации в Вордовский docx файлы уменьшаются до 8-10 раз (зафиксированный мной рекорд – в 15 раз!).

Когда-то мне на форуме pashulka помог с макросом конвертациии всех открытых в Ворде MHT файлов в DOCX (Файлы mht сохранить как docx). Вот код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub SaveAllOpenedMhtAsDocx()
 
For i = Documents.Count To 1 Step -1
    docpath = ActiveDocument.Path ' путь оригинального MHT файла
    docname = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 3) & "docx" ‘заменяем расширение mht на docx
    ChangeFileOpenDirectory docpath
    ActiveDocument.SaveAs docname, wdFormatXMLDocument  ‘записываем файл в ту же папку
    ActiveWindow.Close  ‘закрываем открытый файл
Next i
 
End Sub
Но поскольку мне лениво бродить по директориям, вручную выбирать mht-файлы и открывать по 10-12 файлов (больше-тормозит сильно) я захотел сделать макрос пакетной обработки – указываешь директорию и макрос сам обходит все подпапки, открывает по одному файлу, конвертирует и сохраняет туда же, где находится оригинальный mht-файл.

Поскольку я ОЧЕНЬ слабо программирую, решил сначала сделать без обхода подпапок, только в указанной папке брать файлы, но уже на этом этапе «обломался». Вот так я делаю (всё своровано с форумов):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub FileList() ‘открываем стандартный диалог выбора папки и получаем путь к папке
    Dim V As String
    Dim BrowseFolder As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку или диск"
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            MsgBox "Вы ничего не выбрали!"
            Exit Sub
        End If
    End With
    BrowseFolder = CStr(V)
      
'вызываем процедуру вывода списка файлов
    ListFilesInFolder BrowseFolder, False
 
End Sub
 
'процедура вывода списка файлов:
 
Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
 
    Dim FSO As Object
    Dim SourceFolder As Object
    Dim SubFolder As Object
    Dim FileItem As Object
    Dim cnt As Long
    Dim Путь(1000) As String
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.getfolder(SourceFolderName)
   
    cnt = 0
    For Each FileItem In SourceFolder.Files
        cnt = cnt + 1
        If Right(FileItem.Path, 3) = "mht" Then ‘если это mht-файл то
            Путь(cnt) = FileItem.Path ‘записывем в переменную полный путь
        End If
    Next FileItem
    
‘имеем в переменной Путь() полные пути ко всем mht-файлам из указанной папки
‘Организовываем цикл – открываем файлы по одному и записываем на диск как  mht-файл (конвертируем)
    For i = 1 To cnt
           WordBasic.FileOpen Name:=Путь(i) 'открываем mht-файл
        
           docpath = ActiveDocument.Path 'путь к папке оригинального mht-файла
           docname = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 3) & "docx" ‘заменяем расширение mht на docx
           ChangeFileOpenDirectory docpath
           ActiveDocument.SaveAs docname, wdFormatXMLDocument ‘записываем файл в ту же папку
           ActiveWindow.Close  ‘закрываем открытый файл            
    Next i
 
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
 
End Sub
И ничего не происходит – файлы даже не открываются.
Если я убираю из цикла конвертацию:

Visual Basic
1
2
3
4
5
6
7
8
9
    For i = 1 To cnt
           WordBasic.FileOpen Name:=Путь(i) 'открываем mht-файл
        
[S]           docpath = ActiveDocument.Path 'путь к папке оригинального mht-файла
           docname = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 3) & "docx" ‘заменяем расширение mht на docx
           ChangeFileOpenDirectory docpath
           ActiveDocument.SaveAs docname, wdFormatXMLDocument ‘записываем файл в ту же папку
           ActiveWindow.Close  ‘закрываем открытый файл [/S]           
    Next i
то файлы нормально загружаются и этот же блок конвертации, вызваный как отдельный, самостоятельный макрос, всё прекрасно конвертирует.

В чём я туплю?
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
16.10.2018, 20:49
Ответы с готовыми решениями:

Файлы mht сохранить как docx
Здравствуйте ! Очень нужны такие вот 2 макроса (Word 2007): 1. В Word-e открыты несколько...

Конвертация Docx в PDF
День добрый, Суть такая, что с помощью формы я создаю docx документ, с колонтитулами, картинками,...

Конвертация DOCX в DOC
Добрый день прошу помощи. Требуется способ сконвертить файл из docx в doc собственно как в теме....

Конвертация из DOCX в HTML
Всем доброго времени суток! Есть документ DOCX, который я создал в WORD 2010. Там изображения...

Конвертация docx/doc в html
есть возможность сделать на JS,NodeJS? без использования сторонних API

8
Казанский
14907 / 6309 / 1720
Регистрация: 24.09.2011
Сообщений: 9,977
17.10.2018, 00:48 2
giaber, 39 строку cnt = cnt + 1 поместите под оператор If
Visual Basic
1
2
3
4
5
6
    For Each FileItem In SourceFolder.Files
        If Right(FileItem.Path, 3) = "mht" Then 'если это mht-файл то
            cnt = cnt + 1
            Путь(cnt) = FileItem.Path 'записывем в переменную полный путь
        End If
    Next FileItem
0
giaber
7 / 2 / 0
Регистрация: 16.09.2014
Сообщений: 187
17.10.2018, 18:30  [ТС] 3
Ну я тупооой!
Казанский ! Спасибо большое!

Не могли бы вы подсказать как организовать и с подпапками? Не могу сообразить ведь у меня перед циклом cnt обнуляется и при повторном вызове фигня получится:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Sub FileList() 'открываем стандартный диалог выбора папки и получаем путь к папке
 
    Dim V As String
    Dim BrowseFolder As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку или диск"
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            MsgBox "Вы ничего не выбрали!"
            Exit Sub
        End If
    End With
    BrowseFolder = CStr(V)
      
'вызываем процедуру вывода списка файлов
'если нужно выводить файлы из вложенных папок - True
'если не нужно выводить файлы из вложенных папок - False
    ListFilesInFolder BrowseFolder, False 'TrueFalse
    
End Sub
 
'процедура вывода списка файлов:
Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
 
    Dim FSO As Object
    Dim SourceFolder As Object
    Dim SubFolder As Object
    Dim FileItem As Object
    Dim cnt As Long
    Dim Имя(1000) As String
    Dim Путь(1000) As String
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.getfolder(SourceFolderName)
   
    cnt = 0
    For Each FileItem In SourceFolder.Files
        
        If Right(FileItem.Path, 3) = "mht" Then 'если это mht-файл то
            cnt = cnt + 1
            Путь(cnt) = FileItem.Path 'записывем в переменную полный путь
        End If
        
    Next FileItem
    
    For i = 1 To cnt
        WordBasic.FileOpen Name:=Путь(i) 'открываем mht-файл
        docpath = ActiveDocument.Path ' ' путь MHT файла
        docname = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 3) & "docx" 'заменяем расширение mht на docx
        ChangeFileOpenDirectory docpath
        ActiveDocument.SaveAs docname, wdFormatXMLDocument 'записываем файл в ту же папку
        ActiveWindow.Close 'закрываем файл
        
    Next i
    
'вызываем процедуру повторно для каждой вложенной папки
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    
'очищаем память
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
 
End Sub
0
Alex77755
10981 / 3439 / 591
Регистрация: 13.02.2009
Сообщений: 10,218
17.10.2018, 20:06 4
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Комманда1_Click()
 Dim FSO As Object
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Search FSO.GetFolder("D:\")
End Sub
 
 Sub Search(Fold As Object)
 Dim SubFold As Object, Fil As Object
   Debug.Print Fold
   On Error GoTo ErrHandle
   For Each SubFold In Fold.SubFolders
     Search SubFold
   Next SubFold
   For Each Fil In Fold.Files
        Debug.Print Fil
   Next Fil
   Exit Sub
ErrHandle:
   MsgBox "Нет допуска к папке """ & Fold.Path & """"
   Err.Clear
End Sub
0
17.10.2018, 20:06
giaber
7 / 2 / 0
Регистрация: 16.09.2014
Сообщений: 187
17.10.2018, 21:45  [ТС] 5
Alex77755 !!! Это просто ... слов нет! Красота! Спасибище !!!

Добавлено через 1 час 13 минут
Alex77755 - к сожалению, что-то не так. На диске D у меня 9578 папок - показывает 1926, файлов 260408, показывает 7126
0
shanemac51
Модератор
Эксперт MS Access
9109 / 3502 / 554
Регистрация: 07.08.2010
Сообщений: 9,801
Записей в блоге: 2
18.10.2018, 08:17 6
видимо влияет On Error GoTo ErrHandle

причину угадать сложно, но возможно
--знаки препинания в именах папок и файлов
--скрытые папки
...
0
giaber
7 / 2 / 0
Регистрация: 16.09.2014
Сообщений: 187
20.10.2018, 18:41  [ТС] 7
Да, что-то в этом роде...
0
Alex77755
10981 / 3439 / 591
Регистрация: 13.02.2009
Сообщений: 10,218
20.10.2018, 19:26 8
не сталкивался с уникодом в именах папок, но сталкивался в именах файлов! Не работает FSO с ними
Тоже как вариант...
0
giaber
7 / 2 / 0
Регистрация: 16.09.2014
Сообщений: 187
20.11.2018, 09:52  [ТС] 9
После экспериментов с более чем с десятком разных кодов создания списка файлов с маской по расширению оказалось что все они дают совершенно разные результаты с ОЧЕНЬ большим разбросом (в тысячи файлов!). Выкрутился по-ламерски: создал список файлов mht с помощью программы Locate32, макрос будет забирать пути к файлам из текстового файла и по одному конвертировать.

Всем БОЛЬШОЕ спасибо за помощь!
0
20.11.2018, 09:52
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
20.11.2018, 09:52

Конвертация файла с xml в docx
привет, как можно написать приложение на java для конвертации файла с xml формата в word docx...

Конвертация .docx в .pdf через PHPWord
Как конвертнуть файл .docx в .pdf а затем вывести его на страницу? Если есть другие варианты...

Не был произведен вызов CoInitialize. Или конвертация docx -> pdf в Python(Django)
Добрый день, уважаемые форумчане. Делаю проект на Django, если вкратце - по заполненной...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.