[Iska]

«Немного» не получится:

читать дальше »

Код:

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
'=============================================================================