Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

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

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

Ответ
 
Опции темы
Старый 01.08.2018, 16:46   #11
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 262
Репутация: 56
По умолчанию

чё-то не идет, вечером поковыряюсь часок, спасибо
caute вне форума   Ответить с цитированием
Старый 02.08.2018, 01:59   #12
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 262
Репутация: 56
По умолчанию

Последний совет с ходу сработал. Вышло так:
Код:

Sub SaveAllFormData()
    Dim doc As Document
    Dim fileName As String
Dim path As String:  path = "c:\abc\" ' путь к папке с файлами
    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
    ActiveDocument.SaveAs fileName:=doc.FullName & ".doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False

        doc.Close wdDoNotSaveChanges
        fileName = Dir
    Loop
End Sub

Спасибо, добрые люди!
caute вне форума   Ответить с цитированием
Старый 02.08.2018, 02:11   #13
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 262
Репутация: 56
По умолчанию

а чтобы и вложенные папки макрос обрабатывал в указанной папке, что надо добавить в код?
caute вне форума   Ответить с цитированием
Старый 02.08.2018, 10:39   #14
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 24,495
Репутация: 5308
По умолчанию

Цитата:
Сообщение от caute Посмотреть сообщение
а чтобы и вложенные папки макрос обрабатывал в указанной папке, что надо добавить в код?
код для рекурсивного поиска файлов в поддиректориях можно взять отсюда - http://www.ammara.com/access_image_f...er_search.html
Serge_Bliznykov вне форума   Ответить с цитированием
Старый 02.08.2018, 11:09   #15
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 262
Репутация: 56
По умолчанию

спасибо, а как этот код вставить в имеющийся код?
caute вне форума   Ответить с цитированием
Старый 02.08.2018, 13:13   #16
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 24,495
Репутация: 5308
По умолчанию

Цитата:
Сообщение от caute Посмотреть сообщение
спасибо, а как этот код вставить в имеющийся код?
ну, типа так:

Код:

Sub SaveAllFormData()
    Dim path As String:  path = "c:\abc\" ' путь к папке с файлами    
    Call RecursiveDir(path, "*.docx", True)
End Sub


Public Function RecursiveDir(strFolder As String, _
                             strFileSpec As String, _
                             bIncludeSubfolders As Boolean)

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    Dim doc As Document

    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString

        ' конвертация тут
        Set doc = Application.Documents.Open(strFolder & strTemp)

        ' Save form data
        ActiveDocument.SaveAs fileName:=doc.FullName & ".doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False

        doc.Close wdDoNotSaveChanges


        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop

        'Call RecursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call RecursiveDir(strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If

End Function


Public Function TrailingSlash(strFolder As String) As String
    If Len(strFolder) > 0 Then
        If Right(strFolder, 1) = "\" Then
            TrailingSlash = strFolder
        Else
            TrailingSlash = strFolder & "\"
        End If
    End If
End Function

не проверял.
Serge_Bliznykov вне форума   Ответить с цитированием
Старый 02.08.2018, 15:23   #17
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 262
Репутация: 56
По умолчанию

как часы! благодарствую
caute вне форума   Ответить с цитированием
Старый 02.08.2018, 15:29   #18
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 24,495
Репутация: 5308
По умолчанию

Всегда пожалуйста!
Serge_Bliznykov вне форума   Ответить с цитированием
Старый 04.09.2018, 22:48   #19
сфинкс
Форумчанин
 
Аватар для сфинкс
 
Регистрация: 17.06.2012
Адрес: Русская Сортировка Половинами
Сообщений: 137
Репутация: -40
По умолчанию

свыше 10 лет существует бесплатная программа
переводящая именно из docx в doc

и тоже то же для других офисных

проводник - курсор на файл docx - сохранить как
и сохраняет там же в doc за секунды

и тоже то же для других офисных
сфинкс вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
извлечь фотографии из doc (docx) файла mr_xxx Общие вопросы Delphi 3 31.01.2017 11: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 22: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


19:04.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru