Find sentence in word from colomn A in excel file and add a comment from colomn B

[Frits]

Dear all,

I want to build a macro which adds comments to a Word file.

Currently I have a Word file and an Excel file.

When I open the Word file, I would like the Macro to do the following:

1. Search for sentences from colomn A of the Excel file in the Word file (don't search for the header of colomn A (row 1)).
2. If found in the word file, select the (whole) sentence and add a comment. The text of this comment is located in colomn B from the Excel file.
3. If found, go to 4. If not found, highlight the cell in Excel red.
4. Continue with the next cell in colomn A and loop the process untill all sentences from colomn A of the Excel file are searched.

I currently don't have any script yet..so any help would be more than welcome.:help

Thanks in advance!

kind regards,
Frits

[Doug Robbins]

Try:


Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim i As Long
Dim strfind As String
Dim strcomment As String
Dim rngsentence As range
Dim doctarget As Document
Set doctarget = ActiveDocument
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Open("C:\Users\Doug\Documents\FormLog.xls") 'Replace with the path\filename of your Excel file.
Set xlsheet = xlbook.Worksheets(1)
With xlsheet.range("A1")
For i = 2 To .CurrentRegion.Rows.Count
strfind = .Offset(i - 1, 0)
strcomment = .Offset(i - 1, 1)
doctarget.Activate
Selection.HomeKey wdStory
Selection.ClearFormatting
With Selection.Find
If .Execute(FindText:=strfind, Forward:=True, _
MatchWildcards:=False, Wrap:=wdFindContinue) = True Then
Set rngsentence = Selection.range.Sentences(1)
doctarget.Comments.Add rngsentence, strcomment
Else
xlsheet.range("A1").Offset(i - 1, 0).Interior.ColorIndex = 3
End If
End With
Next i
End With
xlbook.Activate

[Frits]

Hi Doug,

Thanks a lot for this! It works for 95% which is great. I am just wondering whether it would be possible to finetune it a little.

Just a small thing but the Excel file does not open after the command. Maybe it would help to start the script with a small browser in Word in which it is possible to select the required Excel file. Then it opens in Excel and it stays open (hopefully).

Any ideas on how this can be done?

Kind regards,
Frits

[Doug Robbins]

Use:


Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim i As Long
Dim strfind As String
Dim strcomment As String
Dim rngsentence As range
Dim doctarget As Document
Dim fd As FileDialog
Dim strworkbook As String
Set doctarget = ActiveDocument
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select the Excel File."
.Filters.Add "Excel Workbooks", "*.xls; *.xlsx"
If .Show = -1 Then
strworkbook = .SelectedItems(1)
Else
MsgBox "You did not select a workbook."
Exit Sub
End If
End With
Set xlbook = xlapp.Workbooks.Open(strworkbook)
Set xlsheet = xlbook.Worksheets(1)
With xlsheet.range("A1")
For i = 2 To .CurrentRegion.Rows.Count
strfind = .Offset(i - 1, 0)
strcomment = .Offset(i - 1, 1)
doctarget.Activate
Selection.HomeKey wdStory
Selection.ClearFormatting
With Selection.Find
If .Execute(FindText:=strfind, Forward:=True, _
MatchWildcards:=False, Wrap:=wdFindContinue) = True Then
Set rngsentence = Selection.range.Sentences(1)
doctarget.Comments.Add rngsentence, strcomment
Else
xlsheet.range("A1").Offset(i - 1, 0).Interior.ColorIndex = 3
End If
End With
Next i
End With
xlapp.Visible = True
xlbook.Activate

[Frits]

Thanks Doug! Works perfect.

regards,
Frits