Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - Количество примечаний в Word-файлах

Ответить
Настройки темы
VBS/WSH/JS - Количество примечаний в Word-файлах

Аватара для Fresh96

Старожил


Сообщения: 194
Благодарности: 61

Профиль | Отправить PM | Цитировать


Изменения
Автор: Fresh96
Дата: 20-03-2014
Изображения
Тип файла: pdf TestDoc.pdf
(91.0 Kb, 4 просмотров)
Вложения
Тип файла: docx TestDoc.docx
(16.4 Kb, 4 просмотров)
Здравствуйте. Прошу помощи в решении такой задачи:
Есть папка с Word(*docx) файлами. Хотелось бы с помощью скрипта посчитать количество примечаний в каждом из документов и вывести результат в файл(например csv) в виде:
Код: Выделить весь код
Имя файла; Количество примечаний
П2_2.docx;62
И5_1.docx;17
и т.д.

Папку в которой находятся Word-файлы хотелось бы выбирать с помощью стандартного диалога выбора папки (но это не критично).
Заранее благодарю.

Документ с примечаниями (2 шт) приложил.
----
Кросс-темы: тут и тут

Отправлено: 14:06, 19-03-2014

 

Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


Примерно так:
читать дальше »
Код: Выделить весь код
Option Explicit

Dim strDestFile

Dim objSourceFolder
Dim strSourceFolder

Dim objFSO
Dim objFile
Dim objTS

Dim objWord


strDestFile = "out.csv"

Set objSourceFolder = WScript.CreateObject("Shell.Application").BrowseForFolder(0, "Select source folder:", 81, "")

If Not objSourceFolder Is Nothing Then
	strSourceFolder = objSourceFolder.self.Path
	
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If objFSO.FolderExists(strSourceFolder) Then
		Set objWord = Nothing
		Set objTS = objFSO.CreateTextFile(objFSO.BuildPath(strSourceFolder, strDestFile), True)
		
		objTS.WriteLine "Имя файла;Количество примечаний"
		
		For Each objFile In objFSO.GetFolder(strSourceFolder).Files
			Select Case LCase(objFSO.GetExtensionName(objFile.Name))
				Case "doc", "docx"
					If objWord Is Nothing Then
						Set objWord = WScript.CreateObject("Word.Application")
					End If
					
					With objWord.Documents.Open(objFile.Path)
						objTS.WriteLine objFile.Name & ";" & .Comments.Count
						.Close
					End With
				Case Else
					' Nothing to do
			End Select
		Next
		
		objTS.Close
		Set objTS = Nothing
		
		If Not objWord Is Nothing Then
			objWord.Quit
			Set objWord = Nothing
		End If
	Else
		WScript.Echo "Can't use folder [" & strSourceFolder & "]."
		WScript.Quit 1
	End If
Else
	WScript.Echo "Cancelled choice folder."
End If

WScript.Quit 0
Это сообщение посчитали полезным следующие участники:

Отправлено: 18:13, 19-03-2014 | #2



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

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.


Аватара для Fresh96

Старожил


Сообщения: 194
Благодарности: 61

Профиль | Отправить PM | Цитировать


Iska, уже какой раз выручаете. Спасибо.

А не могли бы Вы еще немного подкорректировать скриптик, чтобы он проходился и по файлам в подпапках.
Структура папок, для примера, такая:

Код: Выделить весь код
ПапкаНакоторуюУказываю (в ней несколько подпапок в которых Word-файлы)
           |                                         |
     Папка01 (в ней файлы)    Папка02 (в ней тоже файлы ворда)      ....

Отправлено: 20:07, 19-03-2014 | #3


Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


«Немного» не получится:
читать дальше »
Код: Выделить весь код
Option Explicit

Dim strDestFile

Dim objSourceFolder
Dim strSourceFolder

Dim objFSO
Dim objDictionary
Dim objTS
Dim strPath


strDestFile = "out.csv"

Set objSourceFolder = WScript.CreateObject("Shell.Application").BrowseForFolder(0, "Select source folder:", 81, "")

If Not objSourceFolder Is Nothing Then
	strSourceFolder = objSourceFolder.self.Path
	
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If objFSO.FolderExists(strSourceFolder) Then
		Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
		
		ScanSubFolders objFSO.GetFolder(strSourceFolder)
		
		If objDictionary.Count > 0 Then
			Set objTS = objFSO.CreateTextFile(objFSO.BuildPath(strSourceFolder, strDestFile), True)
			objTS.WriteLine "Путь к файлу;Количество примечаний"
			
			With WScript.CreateObject("Word.Application")
				For Each strPath In objDictionary.Items
					With .Documents.Open(strPath)
						objTS.WriteLine strPath & ";" & .Comments.Count
						.Close
					End With
				Next
				
				.Quit
			End With
			
			objTS.Close
			Set objTS = Nothing
		Else
			WScript.Echo "Nothing found."
		End If
	Else
		WScript.Echo "Can't use folder [" & strSourceFolder & "]."
		WScript.Quit 1
	End If
	
	Set objFSO = Nothing
	Set objSourceFolder = Nothing
Else
	WScript.Echo "Cancelled choice folder."
End If

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub ScanSubFolders(objFolder)
	Dim objSubFolder
	Dim objFile
	
	For Each objFile In objFolder.Files
		Select Case LCase(objFSO.GetExtensionName(objFile.Name))
			Case "doc", "docx"
				objDictionary.Add objFile.Path, objFile.Path
			Case Else
				' Nothing to do
		End Select
	Next
	
	For Each objSubFolder In objFolder.SubFolders
		ScanSubFolders objSubFolder
	Next
End Sub
'=============================================================================
Это сообщение посчитали полезным следующие участники:

Отправлено: 21:04, 19-03-2014 | #4


Аватара для Fresh96

Старожил


Сообщения: 194
Благодарности: 61

Профиль | Отправить PM | Цитировать


Iska, всё работает.

На 160 файлах в 14 подпапках = ~5 минут работы (но это ерунда, по сравнению с ручной обработкой).

Уже совестно просить, но попробовал переделать Ваш файл под обработку PDF (там комментарии). Ничего не выходит, точнее выходит одна ругань скрипта (в программировании я не знаток).

Вот здесь скрипт выполняет подсчет количества страниц в PDF-файлах.

Для подсчета количества страниц в PDF:
Код: Выделить весь код
strFilename="c:\test.pdf"
Set objAcroExch = CreateObject("AcroExch.PDDoc") 
objAcroExch.Open strFilename
CountPages = objAcroExch.GetNumPages
objAcroExch.Close

msgbox CountPages
Как я понимаю, нужно заменить GetNumPages(и, возможно, что то еще) на чтение количества комментариев, но нигде не могу найти, что написать (http://www.onestopqa.com/resources/Accessing PDFs.pdf).

Последний раз редактировалось Fresh96, 20-03-2014 в 11:40.


Отправлено: 08:09, 20-03-2014 | #5


Аватара для Fresh96

Старожил


Сообщения: 194
Благодарности: 61

Профиль | Отправить PM | Цитировать


Наваял такой код для показа количества комментариев:
Код: Выделить весь код
Set pdSourceDoc = CreateObject("AcroExch.PDDoc")

strFilename="C:\1\TestDoc.pdf"
pdSourceDoc.Open strFilename
iSourcePageCount = pdSourceDoc.GetNumPages() 
Set pAcroSourcePage = pdSourceDoc.AcquirePage(0) 
iSourceAnnotationCount = pAcroSourcePage.GetNumAnnots() 
msgbox iSourcePageCount
msgbox iSourceAnnotationCount
Количество страниц "iSourcePageCount" показывает верно, а
количество комментариев "iSourceAnnotationCount" показывает в 2 раза больше. Не пойму почему?

Если этот код верный помогите интегрировать его в код из поста
Цитата Iska:
«Немного» не получится:
читать дальше » »

Отправлено: 13:52, 20-03-2014 | #6


Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


Fresh96, у меня нет Adobe Acrobat.

Цитата Fresh96:
а количество комментариев "iSourceAnnotationCount" показывает в 2 раза больше. Не пойму почему? »
Interapplication Communication API Reference - Adobe:
Цитата:
GetNumAnnots

Gets the number of annotations on the page.

Annotations that have associated pop-up windows, such as a strikeout, count as two annotations. Also note that widget annotations (Acrobat form fields) are included.
Это сообщение посчитали полезным следующие участники:

Отправлено: 14:28, 20-03-2014 | #7


Аватара для Fresh96

Старожил


Сообщения: 194
Благодарности: 61

Профиль | Отправить PM | Цитировать


Iska, спасибо за пояснение.

Получилось так (к сожалению должен быть установлен Adobe Acrobat):
читать дальше »

Код: Выделить весь код
Option Explicit

Dim strDestFile

Dim objSourceFolder
Dim strSourceFolder

Dim iSourcePageCount
Dim iSourceAnnotationCount
Dim iSourceAnnotationCountPage 
Dim pAcroSourcePage
Dim pdSourceDoc

Dim objFSO
Dim objDictionary
Dim objTS
Dim strPath

Dim i


strDestFile = "out_pdf.csv"
iSourceAnnotationCount = 0

Set pdSourceDoc = CreateObject("AcroExch.PDDoc")
Set objSourceFolder = WScript.CreateObject("Shell.Application").BrowseForFolder(0, "Select source folder:", 81, "")

If Not objSourceFolder Is Nothing Then
	strSourceFolder = objSourceFolder.self.Path
	
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If objFSO.FolderExists(strSourceFolder) Then
		Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
		
		ScanSubFolders objFSO.GetFolder(strSourceFolder)
		
		If objDictionary.Count > 0 Then
			Set objTS = objFSO.CreateTextFile(objFSO.BuildPath(strSourceFolder, strDestFile), True)
			objTS.WriteLine "Путь к файлу;Количество примечаний"
			
				For Each strPath In objDictionary.Items
						pdSourceDoc.Open(strPath)
						iSourcePageCount = pdSourceDoc.GetNumPages() 
						for i=0 to iSourcePageCount-1
							Set pAcroSourcePage = pdSourceDoc.AcquirePage(i) 
							iSourceAnnotationCountPage = pAcroSourcePage.GetNumAnnots()/2 
							iSourceAnnotationCount = iSourceAnnotationCount + iSourceAnnotationCountPage
							'msgbox iSourcePageCount
							'msgbox iSourceAnnotationCount	
						Next
						objTS.WriteLine strPath & ";" & iSourceAnnotationCount
						iSourceAnnotationCount = 0
						pdSourceDoc.Close
				Next
			objTS.Close
			Set objTS = Nothing
		Else
			WScript.Echo "Nothing found."
		End If			

	Else
		WScript.Echo "Can't use folder [" & strSourceFolder & "]."
		WScript.Quit 1
	End If
	
	Set objFSO = Nothing
	Set objSourceFolder = Nothing
Else
	WScript.Echo "Вы не выбрали папку с файлами."
End If

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub ScanSubFolders(objFolder)
	Dim objSubFolder
	Dim objFile
	
	For Each objFile In objFolder.Files
		Select Case LCase(objFSO.GetExtensionName(objFile.Name))
			Case "pdf"
				objDictionary.Add objFile.Path, objFile.Path
			Case Else
				' Nothing to do
		End Select
	Next
	
	For Each objSubFolder In objFolder.SubFolders
		ScanSubFolders objSubFolder
	Next
End Sub
'=============================================================================

Последний раз редактировалось Fresh96, 21-03-2014 в 07:20. Причина: Добавил цикл по страницам (т.к. ранее количество примечаний бралось только с первой (0) страницы)


Отправлено: 18:37, 20-03-2014 | #8


Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


Fresh96, не стоит ли вынести создание объекта «AcroExch.PDDoc» за пределы цикла?
Это сообщение посчитали полезным следующие участники:

Отправлено: 18:48, 20-03-2014 | #9


Аватара для Fresh96

Старожил


Сообщения: 194
Благодарности: 61

Профиль | Отправить PM | Цитировать


Подправил.

Отправлено: 19:26, 20-03-2014 | #10



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - Количество примечаний в Word-файлах

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
2007 - [решено] Печать примечаний в MS Excel 2007 murbls Microsoft Office (Word, Excel, Outlook и т.д.) 4 07-02-2014 09:32
VBS/WSH/JS - [решено] Замена текста во всех файлах Word RiskSoft Скриптовые языки администрирования Windows 7 20-04-2012 20:03
2010 - [решено] Word - Как отобразить линейку в Word 2010 Светлана96 Microsoft Office (Word, Excel, Outlook и т.д.) 3 17-01-2012 18:30
2003/XP/2000 - Печать списка примечаний MS Word 2003 AlexM Microsoft Office (Word, Excel, Outlook и т.д.) 0 28-12-2010 12:35
2003/XP/2000 - Word | Открытие документа Word в режиме чтения Qwe1 Microsoft Office (Word, Excel, Outlook и т.д.) 4 24-02-2010 16:41




 
Переход