1

Тема: (решено) макрос сохранения всех док-тов как веб-страницы

какой надо макрос чтобы сохранить в папке все док-ты (.rtf) как веб-страницы ?

Отредактировано romby (22.01.2010 16:45:35)

2

Re: (решено) макрос сохранения всех док-тов как веб-страницы

Вот такой нужно макрос

Sub SaveAllToWeb()
  Dim sDir As String
  Dim sFileName As String
  Dim oDoc As Document
  Dim i As Integer
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Выберите папку"
    If .Show Then sDir = .SelectedItems(1) Else Exit Sub
  End With
  
  Application.ScreenUpdating = False
  sFileName = Dir(sDir & Application.PathSeparator & "*.rtf")
  While Len(sFileName) > 0
    sFileName = sDir & Application.PathSeparator & sFileName
    Set oDoc = Documents.Open(sFileName, False, False, False)
    oDoc.SaveAs Mid(sFileName, 1, InStrRev(sFileName, ".")) & "mht", wdFormatWebArchive, AddToRecentFiles:=False
    oDoc.Close
    sFileName = Dir
    i = i + 1
    DoEvents
  Wend
  Application.ScreenUpdating = True
  MsgBox "Пересохранение завершено. Сохранено " & i & " файлов."
End Sub
Лучше день потерять — потом за пять минут долететь!

3

Re: (решено) макрос сохранения всех док-тов как веб-страницы

Спасибо товарищ админ, четко работает.
сохраняет страницы с расширением .mht
а как сделать чтобы сохранял док-ты с расширением .htm (веб страница и папка с рисунками)

4

Re: (решено) макрос сохранения всех док-тов как веб-страницы

viter.alex спасибо товарищ админ, пашет макрос.

Вот ентот макрос конвертит надо было поменять енту строчку "htm", wdFormatHTML, енто подсказал админ El Sanchez с форума http://forum.oszone.net/forum-102.html

Sub SaveAllToWeb()
  Dim sDir As String
  Dim sFileName As String
  Dim oDoc As Document
  Dim i As Integer
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Выберите папку"
    If .Show Then sDir = .SelectedItems(1) Else Exit Sub
  End With
  
  Application.ScreenUpdating = False
  sFileName = Dir(sDir & Application.PathSeparator & "*.rtf")
  While Len(sFileName) > 0
    sFileName = sDir & Application.PathSeparator & sFileName
    Set oDoc = Documents.Open(sFileName, False, False, False)
    oDoc.SaveAs Mid(sFileName, 1, InStrRev(sFileName, ".")) & [b]"htm", wdFormatHTML,[/b] AddToRecentFiles:=False
    oDoc.Close
    sFileName = Dir
    i = i + 1
    DoEvents
  Wend
  Application.ScreenUpdating = True
  MsgBox "Пересохранение завершено. Сохранено " & i & " файлов."
End Sub

5

Re: (решено) макрос сохранения всех док-тов как веб-страницы

Здравствуйте! viter.alex, Вы написали очень хороший макрос для сохранения веб-страничек. Только папку для сохранения приходится выбирать вручную. А можно ли сделать так, чтобы веб-страницы сохранялись в конкретную, нужную мне папку?

6

Re: (решено) макрос сохранения всех док-тов как веб-страницы

блок

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Выберите папку"
    If .Show Then sDir = .SelectedItems(1) Else Exit Sub
  End With

в урну, вместо него:
sDir = "L:\Мир Эксель" - например

7

Re: (решено) макрос сохранения всех док-тов как веб-страницы

подскажите когда есть диалог выбора папки как указать, чтобы выводил в нужном диске, папке???

8

Re: (решено) макрос сохранения всех док-тов как веб-страницы

Это можно сделать в настройках самого Ворда. Например в Word 2010 это можно сделать: файл\ параметры\сохранение\расположение файлов по умолчанию.

9

Re: (решено) макрос сохранения всех док-тов как веб-страницы

я спрашиваю как програмно указать?