Автор Тема: VBA Макросы: Как заставить Word обрабатывать не только файлы с расширением .doc?  (Прочитано 1159 раз)

Оффлайн Sergi92

  • Посетитель форума
  • Сообщений: 49
Добрый день! Есть такой макрос, который объединяет в один несколько файлов из папки по указанному пути MyPath с расширением .doc

Макрос
Sub MergeDocuments()
  Application.ScreenUpdating = False
  MyPath = ActiveDocument.Path
  MyName = Dir(MyPath & "\" & "*.doc")
  i = 0
  Do While MyName <> ""
  If MyName <> ActiveDocument.Name Then
  Set wb = Documents.Open(MyPath & "\" & MyName)
  Selection.WholeStory
  Selection.Copy
  Windows(1).Activate
  Selection.EndKey Unit:=wdLine
  Selection.TypeParagraph
  Selection.Paste
  i = i + 1
  wb.Close False
  End If
  MyName = Dir
  Loop
  Application.ScreenUpdating = True
  End Sub

Этот макрос берет по очереди файлы из папки по алфавиту. Но если попадается файл с расширением .docx, то он его пропускает.
Вопрос: как быть в этом случае? Как заставить Word обрабатывать не только файлы с расширением .doc, но и еще .docx?

Оффлайн Администратор

  • Administrator
  • Сообщений: 2053
Я путь указал свой, чтобы протестировать.
Обрабатываются все файлы, у которых расширение начинается "doc".

Макрос
Sub MergeDocuments()

    Dim doc As Document, MyPath As String, MyName As String
   
    Application.ScreenUpdating = False
    MyPath = "C:\Users\User\Desktop\Новая папка"
    MyName = Dir(MyPath & "\" & "*.doc*")
    Do While MyName <> ""
      If MyName <> ActiveDocument.Name Then
          Set doc = Documents.Open(MyPath & "\" & MyName)
          Selection.WholeStory
          Selection.Copy
          Windows(1).Activate
          Selection.EndKey Unit:=wdLine
          Selection.TypeParagraph
          Selection.Paste
          doc.Close False
      End If
      MyName = Dir
    Loop
    Application.ScreenUpdating = True
   
End Sub

Оффлайн Sergi92

  • Посетитель форума
  • Сообщений: 49