CODEWITHSUNDEEP
excelvbatextms-worddata-transfer
Jaime Wise
Jaime Wise

Reputation: 11

Automate Word document into excel

I have to transfer hundreds of word documents into excel. The documents are client records from way back, and they look like this:

Date: dd/mm/yy

Employee name: Name

Several lines of text in one paragraph.

There will be dozens of entrees on the page like this, formatted into one column. I need the end result to be one column for each category. The major challenge with this is the text descriptions. The way they are formatted in word, there doesn't seem to be a simple way to copy and paste them into excel without the result being one cell for each line of the paragraph. Any method I've tried that replaces hard returns for soft returns takes all the text on the entire page and puts into one cell, which makes it worse. I have hundreds of files to transfer, so I don't have the time to copy and paste each note into one cell. The paragraphs also are not uniform in length, although there is typically an empty line before and after the note starts/ends. I'm sure there must be a VB solution for this, but I'm not knowledgeable enough to figure it out. Any help would be appreciated.

Upvotes: 1

Views: 150

Answers (1)

ASH
ASH

Reputation: 20302

You can set Bookmarks in Word, and import all Bookmarks into ranges in Excel.

Sub TryThis()
Dim oWord As Word.Application
Dim oDoc As Word.document
Dim vBkMarks As Variant
Dim vRecord
Dim rRecord As Range
Dim nFields As Long
Dim i As Long

vBkMarks = Array("Bookmark1", "Bookmark2", "Bookmark3") 'etc...
ReDim vRecord(LBound(vBkMarks) To UBound(vBkMarks))
nFields = UBound(vBkMarks) - LBound(vBkMarks) + 1
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
On Error GoTo 0
If oWord Is Nothing Then _
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.ActiveDocument
For i = LBound(vBkMarks) To UBound(vBkMarks)
vRecord(i) = oDoc.Bookmarks(vBkMarks(i)).Range.Text
Next i
With Sheets("DataTable")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize( _
1, nFields).Value = vRecord
End With
End Sub

Upvotes: 1

Related Questions