How to siphon data from a Word document

[lmbrady]

I am currently using MS Office Excel 2007 and my limited VBA knowledge has put me at a stop of a project that I have been working on. I am trying to create an excel template that will open every word document in a specific folder and pull data (open to suggestions as to how this would work) located in the title of the document.

For example, I want the spreadsheet to open every document and pull info from the title that would look similar to this:
"line of business";"policy #";"dollar amount";"name";"line of business" and etc.

The semicolons in the title would partition the data across a few cells.

Below is the coding that I currently have, mostly taken directly from excel forums since I am not that knowledgable with VBA.

This is my timestamp. Column A adds a timestamp whenever data is entered into the corresponding cell in Column B. Because of this, I need data to be pulled from Word documents and inserted into Column B.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
For Each Rng In Target
If Not Rng.Value = vbNullString Then
Select Case Rng.Column
Case 2 To 3
If Not IsDate(Cells(Rng.Row, "a").Value) Then
Application.EnableEvents = False
Cells(Rng.Row, "a").Value = Now()
End If

If InStr(Rng.Value, ";") > 0 Then
SplitValue Rng
End If
End Select
End If
Next Rng
Application.EnableEvents = True
End Sub

Below is some coding that was suggested to me, but not very specified to my specific needs. This is where I am in over my head. If anyone could suggest how to tailor this to my project, this would be excellent.


Sub SplitValue(Rng As Range)
Dim avarSplit As Variant

avarSplit = Split(Rng.Value, ";")
Range(Rng, Rng.Offset(, 4)).Value = avarSplit
If Left(Rng.Value, 2) = "RE" Or Left(Rng.Value, 2) = "FW" Then
Rng.Value = Mid(Rng.Value, 4, 500)
End If
End Sub
Sub OpenAndReadWordDoc()
' assumes that the previous procedure has been executed
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim tString As String, tRange As Word.Range
Dim p As Long, r As Long
Workbooks.Add ' create a new workbook
With Range("B1")
.Formula = "Word Document Title:"
.Font.Bold = True
.Font.Size = 11
.Offset(1, 0).Select
End With
r = 3 ' startrow for the copied text from the Word document
Set wrdApp = CreateObject("Word.Application")
'wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Foldername\MyNewWordDoc.doc")
' example word operations
With wrdDoc
For p = 1 To .Paragraphs.Count
Set tRange = .Range(Start:=.Paragraphs(p).Range.Start, _
End:=.Paragraphs(p).Range.End)
tString = tRange.Text
tString = Left(tString, Len(tString) - 1)
' exclude the paragraph-mark
' check if the text has the content you want
If InStr(1, tString, "1") > 0 Then
' fill into active worksheet
ActiveSheet.Range("A" & r).Formula = tString
r = r + 1
End If
Next p
.Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
ActiveWorkbook.Saved = True
End Sub

Also not sure if the word document is to be pulling information from the title, if I would need to negate ".doc" from data being imported.

Any and all help is very much appreciated. Also suggestions as to how to better or more efficiently do something similar to what I am requesting would be excellent.

 

[vaskov17]

Two questions:

1. What does the title mean? Is it the file name, text in the header or the first paragraph that has text in the document?
2. Can you provide a sample of what the information you need pulled looks like in the Word document?

 

[lmbrady]

Good questions. I suppose it would be easiest to use filename. For example the filename would be "Universal life;0000437859;$500.00;John Smith;Endorsed check.txt". The filenames might end up getting too long, so perhaps it could be the first line of text. I was open to suggestions on this aspect of the project.