title: Extracting the Author and Comments from Word to Excel
body: <p>I have the following code which extracts strings of text from a Word document and exports it into an Excel spreadsheet. Column A reads the comments and Column B reads the original text that it refers to. I'd like to also extract the Author who made the comment into the spreadsheet but not sure how to. Thanks.</p>
  
  <pre><code>    Option Explicit
  
  
  
  
     Public Sub FindWordComments()
  'Requires reference to Microsoft Word v14.0 Object Library
  
  Dim objExcelApp As Object
  Dim wb As Object
  Set objExcelApp = CreateObject("Excel.Application")
  Set wb = objExcelApp.Workbooks.Open("C:\Users\cetraig\Documents\Projects\_HRBT\Book1.xlsx")
  
  Dim myWord              As Word.Application
  Dim myDoc               As Word.Document
  Dim thisComment         As Word.Comment
  
  Dim fDialog             As Office.FileDialog
  Dim varFile             As Variant
  
  Dim destSheet           As Worksheet
  Dim rowToUse            As Integer
  Dim colToUse            As Long
  
  Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
  Set destSheet = wb.Sheets("Sheet1")
  colToUse = 1
  
  With fDialog
      .AllowMultiSelect = True
      .Title = "Import Files"
      .Filters.Clear
      .Filters.Add "Word Documents", "*.docx"
      .Filters.Add "Word Macro Documents", "*.docm"
      .Filters.Add "All Files", "*.*"
  End With
  
  If fDialog.Show Then
  
      For Each varFile In fDialog.SelectedItems
  
          rowToUse = 2
  
          Set myWord = New Word.Application
          Set myDoc = myWord.Documents.Open(varFile)
  
          For Each thisComment In myDoc.Comments
  
              With thisComment
                  destSheet.Cells(rowToUse, colToUse).Value = .Range.Text
                  destSheet.Cells(rowToUse, colToUse + 1).Value = .Scope.Text
                  destSheet.Columns(2).AutoFit
              End With
  
              rowToUse = rowToUse + 1
  
          Next thisComment
  
          destSheet.Cells(1, colToUse).Value = Left(myDoc.Name, 4)
          'Put name of interview object in cell A1
  
          destSheet.Cells(1, colToUse + 1).Value = ActiveDocument.Words.Count
          'Put the number of words in cell B1
  
          Set myDoc = Nothing
          myWord.Quit
  
          colToUse = colToUse + 2
  
      Next varFile
  
      End If
  
      End Sub
  </code></pre>