A short VBscript that will extract comments from a Word document and store them as a table in Excel. Created for part of a project that involves "coding" a large number of transcripts according to certain arbitrary categories.

extractor.vbs

Option Explicit

' #############################################################
' #
' # Define Objects and Variables
' # 

Dim oFSO
Dim LogFile
Dim strPath
Dim strFileName
Dim strLogFile
Dim strInputFile
Dim strOutputFile
Dim objWord
Dim objExcel
Dim objExcelSheet
Dim intCommentCount
Dim x

Const wdDoNotSaveChanges = 0

strFileName = WScript.Arguments.item(0)
strPath = "C:\path\to\working\directory\"
strLogFile = "extrator.log"
strInputFile = strPath & strFileName & ".docx"
strOutputFile = strPath & strFileName & ".xlsx"

' #############################################################
' #
' # Setup
' # 

' Set up log file
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set LogFile = oFSO.CreateTextFile(strLogFile,true)
LogText "Started"

' Open Word document to serve as input
LogText "Opening input: " & strInputFile
Set objWord = CreateObject("Word.Application")
objWord.Visible = false
objWord.documents.open(strInputFile)
LogText "Document opened"

' Open new Excel spreadsheet for output
LogText "Opening output: " & strInputFile
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = false
objExcel.Workbooks.Add
LogText "Spreadsheet opened"


' #############################################################
' #
' # Start work
' # 

' How many comments are found?
intCommentCount = objWord.Documents(1).Comments.Count

if intCommentCount >= 1 then
	LogText "Found " & intCommentCount & " comments."

	' Set output columns
	objExcel.Cells( 1, 1 ).Value = "Transcript"
	objExcel.Cells( 1, 2 ).Value = "Coder"
	objExcel.Cells( 1, 3 ).Value = "Comment Text"
	objExcel.Cells( 1, 4 ).Value = "Transcript Excerpt"

	' Loop through comments, storing details
	for x = 1 to intCommentCount
		LogText x
		LogText objWord.Documents(1).Comments(x).Author
		LogText objWord.Documents(1).Comments(x).Range
		LogText objWord.Documents(1).Comments(x).Scope
		LogText ""

		objExcel.Cells( x+1, 1 ).Value = strFileName
		objExcel.Cells( x+1, 2 ).Value = objWord.Documents(1).Comments(x).Author
		objExcel.Cells( x+1, 3 ).Value = objWord.Documents(1).Comments(x).Range
		objExcel.Cells( x+1, 4 ).Value = objWord.Documents(1).Comments(x).Scope
	next

else 
	LogText "No comments found. Nothing to do."
end if

' #############################################################
' #
' # Teardown
' # 

' Close Excel spreadsheet
LogText "Closing spreadsheet..."
objExcel.ActiveWorkbook.SaveAs(strOutputFile)
objExcel.Quit
Set objExcel = Nothing
LogText "Spreadsheet closed"

' Close Word document
' TODO: Closing still leaves Word open somehow???
LogText "Closing Document..."
objWord.documents.close(wdDoNotSaveChanges)
objWord.Quit
Set objWord = Nothing
LogText "Document closed"

' Tear down log file
LogText "Finished"
Set LogFile = Nothing
Set oFSO = Nothing

wscript.echo("Finished!")

' #############################################################
' #
' # Subroutines
' # 

Sub LogText(strMessage)
	LogFile.WriteLine(now() & ":" & vbTab & strMessage)
End Sub