Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 01.08.2018, 00:34   #1
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 277
По умолчанию макрос пакетной конвертации docx в doc

На борту 300 файлов в формате docx. Существует ли макрос, который умеет их пакетно конвертировать в doc? (у меня Word 2003 и он крайне медленно открывает docx'ы).
caute вне форума Ответить с цитированием
Старый 01.08.2018, 09:34   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от caute Посмотреть сообщение
Существует ли макрос, который умеет их пакетно конвертировать в doc?
ну, такой макрос можно и написать (если готовый не найдётся).


Цитата:
Сообщение от caute Посмотреть сообщение
(у меня Word 2003 и он крайне медленно открывает docx'ы
не смущает, что формат DOCX - это расширенный формат? В нём могут быть фишки, недоступные в DOC. (например, может "поплыть" разметка, оформление, шрифты и т.д.)
Вы пробовали взять несколько произвольных штук из ваших 300 и сконвертировать в DOC?
Всё сохранилось? Открывается быстро?



Сделайте копию своих документов и попробуйте, например, такой макрос:
Код:
Sub SaveAllFormData(path As String)
    Dim doc As Document
    Dim fileName As String

    fileName = Dir(path & "*.docx")

     ' Loop through all .docx files in that path
    Do While fileName <> ""
        Set doc = Application.Documents.Open(path & fileName)

         ' Save form data
        doc.SaveAs2 FileName:=doc.FullName & ".doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=0

        doc.Close wdDoNotSaveChanges
        fileName = Dir
    Loop
End Sub

ВНИМАНИЕ! Макрос не проверял!

если макрос не работает, попробуйте изменить макрос отсюда https://wordribbon.tips.net/T000643_...s_to_DOCX.html

Последний раз редактировалось Serge_Bliznykov; 01.08.2018 в 09:44.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 01.08.2018, 11:52   #3
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 277
По умолчанию

Мои файлы без всяких затей тексты, плыть нечему - конвертировать пробовал, нормально выходит.
Ваш макрос не понял как запустить и где вписать пути к каталогу (проблема еще в том, что там вложенные каталоги, штук 20, но это я и по очереди могу, не страшно)
Попробовал доработать америкосовский макрос, мозгов не хватило, что-то такое вот вышло:

Код:
Sub ConvertBatchToDOC()
    Dim sSourcePath As String
    Dim sTargetPath As String
    Dim sDocName As String
    Dim docCurDoc As Document
    Dim sNewDocName As String

    ' Looking in this path
    sSourcePath = "c:\333\"
    sTargetPath = "c:\444\"

   ' Look for first DOCX file
    sDocName = Dir(sSourcePath & "*.docx")
    Do While sDocName <> ""
        ' Repeat as long as there are source files
        
        'Only work on files where right-most characters are ".docx"
        If Right(sDocName, 4) = ".docx" Then
            ' Open file
            Set docCurDoc = Documents.Open(fileName:=sSourcePath & sDocName)

            sNewDocName = Replace(sDocName, ".docx", ".doc")

            With docCurDoc
                .SaveAs fileName:=sTargetPath & sNewDocName, _
                  FileFormat:=wdFormatDocumentDefault
                .Close SaveChanges:=wdDoNotSaveChanges
            End With
        End If
        ' Get next source file name
        sDocName = Dir
    Loop
    MsgBox "Finished"
End Sub
caute вне форума Ответить с цитированием
Старый 01.08.2018, 12:04   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

думаю, что в "америкосовском" нужно ещё формат поменять:
Код:
            With docCurDoc
                .SaveAs fileName:=sTargetPath & sNewDocName, _
                  FileFormat:=wdFormatDocument
                .Close SaveChanges:=wdDoNotSaveChanges
            End With
а в чём проблема запустить макрос?

откройте MS Word. Нажмите Alt-F11. Откроется редактор Visual Basic.
слева на нужном документе (в котором будет данный макрос) правой кнопкой мышки - "Insert" -> "Module"
справа откроется окошко - туда вставить текст макроса.
Выполнить либо кнопкой "Run" (F5) в редакторе VBA.
Либо перейти в документа, нажать Alt-F8, выбрать имя макроса из списка и нажать кнопку "Выполнить" на форме.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 01.08.2018, 12:12   #5
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 277
По умолчанию

проблема в том, что при нажатии Run всплывает окно "Макрос", а в списке там нет SaveAllFormData и по-прежнему неизвестно, куда пути прописать
Америкосовский макрос подправил - срабатывает, но ничего не создается. Симулирует, в общем
caute вне форума Ответить с цитированием
Старый 01.08.2018, 13:47   #6
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

если макрос с параметром, его не будет в списке
Код:
Sub SaveAllFormData()
    Dim doc As Document
    Dim fileName As String
dim path as string:  path = "c:\333\" ' смотрим папку 333 на Ц
    fileName = Dir(path & "*.docx")

     ' Loop through all .docx files in that path
    Do While fileName <> ""
        Set doc = Application.Documents.Open(path & fileName)

         ' Save form data
        doc.SaveAs2 FileName:=doc.FullName & ".doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=0

        doc.Close wdDoNotSaveChanges
        fileName = Dir
    Loop
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 01.08.2018, 14:36   #7
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 277
По умолчанию

увы
Run-time error '438':
Object doesn't support this property or method
caute вне форума Ответить с цитированием
Старый 01.08.2018, 14:50   #8
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

на какой строке кода возникает ошибка?

если не выпадает - попробуйте пройтись по коду пошагово: в редакторе нажимайте клавишу F8
Serge_Bliznykov вне форума Ответить с цитированием
Старый 01.08.2018, 14:56   #9
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 277
По умолчанию

ошибка в блоке ' Save form data
caute вне форума Ответить с цитированием
Старый 01.08.2018, 15:14   #10
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

А если этот блок заменить на такой:

Код:
 ' Save form data
doc.SaveAs2 FileName:=doc.FullName & ".doc", FileFormat:= _
        wdFormatDocument
работает?


если это не поможет, то
откройте ручками любой DOCX, включите макрорекордер ("Запись макроса"),
сохраните файл как нужно, остановите запись макрорекордера,
перейдите в записанный код и скопируйте сохранение оттуда.
возможно, что в MS Word 2003 код сохранения чуть отличался.
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
извлечь фотографии из doc (docx) файла mr_xxx Общие вопросы Delphi 3 31.01.2017 10:20
Конвертация docx в doc Delphi_ProGer Общие вопросы Delphi 7 11.06.2012 09:01
*.DOC в *.DOCX IP (O IM /A IH Microsoft Office Word 7 31.10.2010 21:12
Как сохранить .doc в docx? beda Microsoft Office Word 7 24.06.2010 15:37
Открытие .doc или .docx в MS Word MADDAN Microsoft Office Word 4 16.09.2008 21:55