Войти

Показать полную графическую версию : [решено] пакетная конвертация документов Word в HTML


romby
15-01-2010, 15:21
в папке все док-ты ворд надо сохранить как веб страницы, ето как сделать через бат.
спасибо

ентот макрос решение кому нада будет (спс админам El Sanchez, и viter.alex админ с форума http://wordexpert.ru/forum/viewforum.php?id=3



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, ".")) & "htm", wdFormatHTML, AddToRecentFiles:=False
oDoc.Close
sFileName = Dir
i = i + 1
DoEvents
Wend
Application.ScreenUpdating = True
MsgBox "Пересохранение завершено. Сохранено " & i & " файлов."
End Sub

Vadikan
17-01-2010, 03:19
romby, в 2003 http://support.microsoft.com/kb/826174 А в 2007 макросом можно... http://help.lockergnome.com/office/Batch-conversion-DOC-HTML-free-software--ftopict927812.html

romby
17-01-2010, 06:40
подскажите товарищ админ как пользовацца твоим советом офис 2007, на диске С папка doc в ней док-ты ворд (.rtf)
2003 офиса нету, есть 2002, могу поставить на виртуальную машину win xp, не умею ставить программы на виртуальную систему и копировать туда док-ты.

ZeLiK
17-01-2010, 10:03
Офисом 2007 так же как и другими, потребуются макросы, а "как и чаво" написано по данным выше Администратором ссылкам, и там же можно дальше пойти и увидеть скрины... Или Вы подразумеваете о полной ммм мягко говоря "капитуляции"?
Установка ПО на виртуальную машину НИЧЕМ не отличается от того же в обычной "машине". Мб Вы забываете выделить устройства для вирт. машины? Можно настроить сеть и перекинуть по сети, можно с помощью флешки, "дав" usb-порт виртуальной машине... собственно, зачем знать/Уметь ставить вирт. машину без знания главного (на мой взгляд)?

Vadikan
17-01-2010, 14:48
romby, ок, копирую сюда то, что есть по ссылке.

Код макроса

Sub SaveAllAsHTM()
Dim FirstLoop As Boolean
Dim myFile As String
Dim strDocName As String
Dim PathToUse As String
Dim MyDoc As Document
Dim Response As Long

PathToUse = InputBox("Path To Use?", "Path", "D:\My
Documents\Test\Versions")

On Error Resume Next
Documents.Close SaveChanges:=wdPromptToSaveChanges
FirstLoop = True
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
Set MyDoc = Documents.Open(PathToUse & myFile)
If FirstLoop Then
'With ActiveDocument
'Selection.PageSetup.Orientation = wdOrientLandscape
'End With
FirstLoop = False

Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
'Else
'With ActiveDocument
'Selection.PageSetup.Orientation = wdOrientLandscape
'End With
End If
strDocName = ActiveDocument.FullName
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".htm"
MyDoc.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatHTML
MyDoc.Close SaveChanges:=wdDoNotSaveChanges
myFile = Dir$()
Wend
End Sub

Добавление макроса (в картинках) (http://www.gmayor.com/installing_macro.htm)

Теперь, что конкретно непонятно?

romby
17-01-2010, 19:52
макрос сохраняет один док-т в папке
создаю новый док-т в него вставляю макрос етот макрос сохраняет новый док-т как веб страницу другие док-ты в папке не сохраняет.

Vadikan
18-01-2010, 00:37
romby, при условии, что у вас макрос сохранен. Запустите его - он попросит указать папку с документами для конвертации.

romby
18-01-2010, 16:54
здраствуйте товарищ админ. ентот макрос не пашет у меня, запускаю макрос оно спрашивает D:\MyDocuments\Test\Versions пишу ей C:\doc , а она не дает, не конвертит док-ты.
попробую скачат 2003 офис и поставить на виртуальную машину.

Vadikan
18-01-2010, 19:53
romby, я проверил макрос перед тем, как предложить решение - у меня все работало (Windows 7, Office 2007).

ZeLiK
19-01-2010, 03:27
Vadikan, Ваши док-ты были формата\расширения *.rtf или *.doc?
romby, За отсутствием установленного Офиса как такового, могу лишь посоветовать отредактировать макрос, как минимум в пункте: myFile = Dir$(PathToUse & "*.doc")
Соответственно "*.doc" заменить на "*.rtf". И проверить, пересохранился\заменился ли макрос.
Как максимум, так же отредактировать в макросе путь с "D:\My Documents\Test\Versions" на "C:\doc"

El Sanchez
19-01-2010, 15:39
romby, если вам макрос, предложенный Vadikan, кажется слишком сложным и так как категория темы CMD/BAT, то предложу макрос попроще и bat-файл:

Макрос:

Sub SaveAsHTM()
NewFilename = (Replace(ActiveDocument.FullName, ".rtf", ".htm"))
ActiveDocument.SaveAs FileName:=NewFilename, FileFormat:=wdFormatHTML
Application.Quit
End Sub


bat-файл для Office 2003:

@echo off
set "SRC=c:\doc"
for /f "tokens=*" %%a in ('dir /b "%SRC%\*.rtf"') do (
start /wait /min "" "%ProgramFiles%\Microsoft Office\OFFICE11\WINWORD.EXE" "%SRC%\%%a" /q /mSaveAsHTM
)


bat-файл для Office 2007:

@echo off
set "SRC=c:\doc"
for /f "tokens=*" %%a in ('dir /b "%SRC%\*.rtf"') do (
start /wait /min "" "%ProgramFiles%\Microsoft Office\OFFICE12\WINWORD.EXE" "%SRC%\%%a" /q /mSaveAsHTM
)


P.S. Макрос в Office 2007 не проверял

romby
22-01-2010, 04:35
ZeLiK, Vadikan, El Sanchez, товарищи админы не пашут у меня енти макросы, и бат тоже не пашет.

ентот макрос создает папку веб страницы, саму страницу не хочет конвертить.
бат открывает документ и зависает, не двигается дальше.


Sub SaveAsHTM()
NewFilename = (Replace(ActiveDocument.FullName, ".rtf", ".htm"))
ActiveDocument.SaveAs FileName:=NewFilename, FileFormat:=wdFormatHTML
Application.Quit
End Sub



реально пашет ентот макрос, его посоветовал админ с форума http://wordexpert.ru/forum/viewforum.php?id=3
конвертит документы в формат .mht енто веб страница в одном файле, а как сделать чтобы сохраняла веб страницу с папкой я не знаю (енто в офисе 2007 меню-сохранить как-другие форматы-веб-страница (*.htm, *.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, ".")) & "mht", wdFormatWebArchive, AddToRecentFiles:=False
oDoc.Close
sFileName = Dir
i = i + 1
DoEvents
Wend
Application.ScreenUpdating = True
MsgBox "Пересохранение завершено. Сохранено " & i & " файлов."
End Sub

El Sanchez
22-01-2010, 15:11
romby, батник для Office 2007 переделал (убрал ключ /f из параметров запуска winword.exe).
конвертит документы в формат .mht енто веб страница в одном файле, а как сделать чтобы сохраняла веб страницу с папкой я не знаю (енто в офисе 2007 меню-сохранить как-другие форматы-веб-страница (*.htm, *.html) »

В строке

oDoc.SaveAs Mid(sFileName, 1, InStrRev(sFileName, ".")) & "mht", wdFormatWebArchive, AddToRecentFiles:=False

замените:
mht на htm (расширение будущего файла)
wdFormatWebArchive на wdFormatHTML (константа свойства SaveFormat объекта FileConverter, означающая, что документ будет сохранен как веб-страница)

Список констант можно посмотреть здесь (http://infotools.ru/products/AXAPI/BRIZLGWORD/BRIZLGWORD/_DocSaveAs.htm)

P.S. Если исходные файлы не формата .rtf, то в строке

sFileName = Dir(sDir & Application.PathSeparator & "*.rtf")

*.rtf замените на нужное расширение.

romby
22-01-2010, 16:35
El Sanchez, спасибо товарищ админ, пашет ентот макрос
четко конвертит

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, ".")) & "htm", wdFormatHTML, AddToRecentFiles:=False
oDoc.Close
sFileName = Dir
i = i + 1
DoEvents
Wend
Application.ScreenUpdating = True
MsgBox "Пересохранение завершено. Сохранено " & i & " файлов."
End Sub

alexey_vf
23-01-2011, 09:53
@echo off set "SRC=c:\doc" for /f "tokens=*" %%a in ('dir /b "%SRC%\*.rtf"') do ( start /wait /min "" "%ProgramFiles%\Microsoft Office\OFFICE12\WINWORD.EXE" "%SRC%\%%a" /q /mSaveAsHTM »

Огромное спасибо автору! Код работает и для MS Word 2010.

Правда чуток подправил чтобы перебирались файлы и из всех поддиректорий (dir /s /b) и чуть упростил:

rem @echo off
set SRC="P:\Geo_Library_v_03_OCR_rtf\temp"

for /f %%a in ('dir /s /b "%SRC%\*.rtf"') do (
start /wait /min "" "C:\Program Files\Microsoft Office\Office14\WINWORD.EXE" "%%a" /q /mSaveAsHTM
)

zenitcd12@vk
25-03-2023, 19:02
если вам макрос, предложенный Vadikan, кажется слишком сложным »
Добрый вечер, а если мне макрос, предложенный Vadikan, кажется сложным, но... все же менее сложным чем батник (тут хоть с пятого на десятое понимаю, а там чет вообще китайская грамота), не подскажите как добавить в него перебор всех файлов во всех подпапках?




© OSzone.net 2001-2012