Import MS-Excel columns to MS-Word as Comments

Question

Situation: I am trying to search through a word document for Keyword/IDs contained in an excel, and add comments from the spreadsheet to the word document for every occurrence of the Keyword/IDs then save. The sample code I have runs through the list of Keyword/IDs, but only comments the first occurrence

Give: The word file is located at C:\Test\ACBS.docx and the excel executing the VBA macro is located separately. In the Excel the search term variable “FindWord” is in column A , and the comment is the variable “CommentWord” in column B.

Problem: How can I get this to search through the entire word document and comment each occurrence of the Keyword/IDs?

Code:

Sub Comments_Excel_to_Word()
'Author: Paul Keahey
'Date: 2017-10-30
'Name:Comments_Excel_to_Word
'Purpose: To bring in comments From Excel to Word.
'Comments: None

Dim objWord
Dim objDoc
Dim objSelection
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("C:\Test\ACBS.docx")
objWord.Visible = True
Set objSelection = objWord.Selection
Dim oRng As Word.range
Set oRng = objSelection.range
Set oScope = oRng.Duplicate
Dim oCol As New Collection
Dim FindWord As String
Dim CommentWord As String
Dim I As Integer



'initalize list of varables


For I = 2 To range("A1").End(xlDown).Row

FindWord = Sheet1.range("A" & I).Value
CommentWord = Sheet1.range("B" & I).Value

 With oRng.Find
    .Text = FindWord
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    Do While .Execute = True
        If oRng.InRange(oScope) Then
            On Error Resume Next
            'MsgBox "oRng.InRange(oScope)"
            oCol.Add oRng.Text, oRng.Text
            On Error GoTo 0
                oRng.Collapse wdCollapseEnd
                Else
             ActiveDocument.Comments.Add oRng, CommentWord

                Exit Do
            End If
        Loop

    End With
Next I

objDoc.Save

End Sub

I'm no Word expert, but the ActiveDocument.Comments.Add line is in the Else block of your If, which is IMHO never reached since oRng.InRange(oScope) is always True. — Excelosaurus
The oRng.InRange(oScope) is not always true, because this code does add the comments to the word document. — Paulray Keahey

ASH ASH · Accepted Answer · 2017-11-02T23:00:25

I'm not sure I understand the Word component of this setup, but if you want to list all comments in your Excel file, you can use the script below to do that.

Sub ShowCommentsAllSheets()
'Update 20140508
Dim commrange As Range
Dim rng As Range
Dim ws As Worksheet
Dim newWs As Worksheet
Set newWs = Application.Worksheets.Add
newWs.Range("A1").Resize(1, 4).Value = Array("Sheet", "Address", "Value", "Comment")
Application.ScreenUpdating = False
On Error Resume Next
For Each ws In Application.ActiveWorkbook.Worksheets
    Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
    If Not commrange Is Nothing Then
        i = newWs.Cells(Rows.Count, 1).End(xlUp).Row
        For Each rng In commrange
            i = i + 1
            newWs.Cells(i, 1).Resize(1, 4).Value = Array(ws.Name, rng.Address, rng.Value, rng.Comment.Text)
        Next
    End If
    Set commrange = Nothing
Next
newWs.Cells.WrapText = False
Application.ScreenUpdating = True
End Sub

Import MS-Excel columns to MS-Word as Comments

1 Answers