Crossie
01-16-2009, 07:49 AM
Hi,
I am new to VB and am also new to the forum so i hope you guys can help me out. I want to create a Macro that will search for certain words in a document and extract both the sentence that contains them and also the sentence before and after that sentence to a excel spreadsheet. I found the code below submitted by Lucas on this site but it will only extract the sentence and not the ones either side. I was also wondering if it it is possible to record the document name and page number in seperate columns in the same spreadsheet. Any help you can give me would be greatly appreciated!
Thanks,
Crossie
Lucas' code:
Option Explicit
Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
Dim intRowCount As Integer
intRowCount = 1
Set aRange = ActiveDocument.Range
With aRange.Find
Do
.Text = "shall" ' the word I am looking for
.Execute
If .Found Then
aRange.Expand Unit:=wdSentence
aRange.Copy
aRange.Collapse wdCollapseEnd
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
'Change the file path to match the location of your test.xls
Set objSheet = appExcel.workbooks.Open("C:\temp\test.xls").Sheets("Sheet1")
intRowCount = 1
End If
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
intRowCount = intRowCount + 1
End If
Loop While .Found
End With
If Not objSheet Is Nothing Then
appExcel.workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
Set aRange = Nothing
End Sub
I am new to VB and am also new to the forum so i hope you guys can help me out. I want to create a Macro that will search for certain words in a document and extract both the sentence that contains them and also the sentence before and after that sentence to a excel spreadsheet. I found the code below submitted by Lucas on this site but it will only extract the sentence and not the ones either side. I was also wondering if it it is possible to record the document name and page number in seperate columns in the same spreadsheet. Any help you can give me would be greatly appreciated!
Thanks,
Crossie
Lucas' code:
Option Explicit
Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
Dim intRowCount As Integer
intRowCount = 1
Set aRange = ActiveDocument.Range
With aRange.Find
Do
.Text = "shall" ' the word I am looking for
.Execute
If .Found Then
aRange.Expand Unit:=wdSentence
aRange.Copy
aRange.Collapse wdCollapseEnd
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
'Change the file path to match the location of your test.xls
Set objSheet = appExcel.workbooks.Open("C:\temp\test.xls").Sheets("Sheet1")
intRowCount = 1
End If
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
intRowCount = intRowCount + 1
End If
Loop While .Found
End With
If Not objSheet Is Nothing Then
appExcel.workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
Set aRange = Nothing
End Sub