Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.