gunny2k9
06-16-2012, 01:54 PM
Hi all,
just wondered if anyway has already tried this and has any code they could share?
basicly i get random word documents sent to me and i have to search through the document and find a specific word and then copy that line/sentence to a excel report.
eg.
data in word doc
word one five nine will run
word two three one will not run
word six ten four will run
word two three one will not run
basicly need excel to search for will not run if found copy the whole sentence "word two three one will not run"and put in a cell
for a greater understanding i found this on the web:
Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
'Dim bRange As Range
Dim intRowCount As Integer
Dim strFileNameAndPath As String
Dim lngDisplayVal As Long
Dim PathAndFileName As String
On Error Resume Next
'open dialog box for user to select file
'and put path and file name in varable
With Application.Dialogs(wdDialogFileOpen)
.Name = "C:\*.*"
lngDisplayVal = .Display
strFileNameAndPath = WordBasic.FileNameInfo$(.Name, 1)
End With
If lngDisplayVal <> -1 Then
MsgBox Prompt:="Procedure canceled. Must select a file."
Exit Sub
End If
intRowCount = 1
Set aRange = ActiveDocument.Range
'Set bRange = ActiveDocument.Range
With aRange.Find
Do
.Text = "will not run" ' search word
.Execute
If .Found Then
aRange.Expand unit:=wdSentence
aRange.Copy
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.Workbooks.Open(strFileNameAndPath).Sheets("Sheet1")
End If
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
'bRange.End = aRange.End
'bRange.Collapse wdCollapseEnd
'bRange.Find.ClearFormatting
'bRange.Find.Font.Bold = True
'With bRange.Find
'.Text = ""
'.Forward = False
'.Wrap = wdFindStop
'.Format = True
'End With
'bRange.Find.Execute
'bRange.Copy
'objSheet.Cells(intRowCount, 1).Select
'objSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
'False
intRowCount = intRowCount + 1
aRange.Collapse wdCollapseEnd
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
End Sub
but that works from with in MS Word... i dont want to have to open the doc and run the copy and then open excel ...
i want the reverse to load excel and press button to select word.doc and it search the doc and then place the sentence inside the already open Excel.xls
am i just asking for too much ?
just wondered if anyway has already tried this and has any code they could share?
basicly i get random word documents sent to me and i have to search through the document and find a specific word and then copy that line/sentence to a excel report.
eg.
data in word doc
word one five nine will run
word two three one will not run
word six ten four will run
word two three one will not run
basicly need excel to search for will not run if found copy the whole sentence "word two three one will not run"and put in a cell
for a greater understanding i found this on the web:
Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
'Dim bRange As Range
Dim intRowCount As Integer
Dim strFileNameAndPath As String
Dim lngDisplayVal As Long
Dim PathAndFileName As String
On Error Resume Next
'open dialog box for user to select file
'and put path and file name in varable
With Application.Dialogs(wdDialogFileOpen)
.Name = "C:\*.*"
lngDisplayVal = .Display
strFileNameAndPath = WordBasic.FileNameInfo$(.Name, 1)
End With
If lngDisplayVal <> -1 Then
MsgBox Prompt:="Procedure canceled. Must select a file."
Exit Sub
End If
intRowCount = 1
Set aRange = ActiveDocument.Range
'Set bRange = ActiveDocument.Range
With aRange.Find
Do
.Text = "will not run" ' search word
.Execute
If .Found Then
aRange.Expand unit:=wdSentence
aRange.Copy
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.Workbooks.Open(strFileNameAndPath).Sheets("Sheet1")
End If
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
'bRange.End = aRange.End
'bRange.Collapse wdCollapseEnd
'bRange.Find.ClearFormatting
'bRange.Find.Font.Bold = True
'With bRange.Find
'.Text = ""
'.Forward = False
'.Wrap = wdFindStop
'.Format = True
'End With
'bRange.Find.Execute
'bRange.Copy
'objSheet.Cells(intRowCount, 1).Select
'objSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
'False
intRowCount = intRowCount + 1
aRange.Collapse wdCollapseEnd
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
End Sub
but that works from with in MS Word... i dont want to have to open the doc and run the copy and then open excel ...
i want the reverse to load excel and press button to select word.doc and it search the doc and then place the sentence inside the already open Excel.xls
am i just asking for too much ?