Importing Data From MS Word to MS Excel

Brainiac

New member
Joined
Aug 18, 2019
Messages
4
Reaction score
0
Points
0
Location
Texas
Excel Version(s)
Office 365 Home
I've got a challenging project. I have hundreds of sermons that I have written in MS Word. They all have the exact same header format which describes various information for each sermon such as: Series, Title, Main Idea, Text, and Date. Then the sermon outline is in the body of the document. I want to create an Excel Spreadsheet containing the header info from each Word file. To say it another way, I want to import the data from each MS Word Header, to populate the fields in the Excel Spreadsheet. Technically, I can do this by hand, but who has that much time? I would prefer to automate this process, but I haven't a clue how to do it. Thanks much, Brainiac
 
--------------- Header
Series: Hebrews Title: The Supremacy of Christ
Main Idea: Christ is the ultimate meaning of life.
Text: Hebrews 1:1-18
Date: Oct. 4, 2017. FBC Bovina, Morning Service
--------------- Body
Introduction
This begins the body of the sermon.
I. Main point One
A. Sub point
II. Main point two
A. Sub point
III. Conclusion


----------------------------- Import into Excel
Series Title Text Date Location
 
Try the following Excel macro (for a PC):
Code:
Sub GetSermonData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document, StrTxt As String
Dim strFolder As String, strFile As String, WkSht As Worksheet, r As Long
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
Set WkSht = ActiveSheet
r = WkSht.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    With .Range.Find
      .Text = "(Date: [!^13]@[0-9](4))."
      .Replacement.Text = "\1^pLocation:"
      .Forward = True
      .Format = False
      .Wrap = wdFindContinue
      .MatchWildcards = True
      .Execute Replace:=wdReplaceOne
    End With
    StrTxt = .Range.Text: r = r + 1
    .Close SaveChanges:=False
  End With
  On Error Resume Next
  WkSht.Cells(r, 1).Value = Trim(Split(Split(StrTxt, "Series:")(1), "Title:")(0))
  WkSht.Cells(r, 2).Value = Trim(Split(Split(StrTxt, "Title:")(1), vbCr)(0))
  WkSht.Cells(r, 3).Value = Trim(Split(Split(StrTxt, "Main Idea:")(1), vbCr)(0))
  WkSht.Cells(r, 4).Value = Trim(Split(Split(StrTxt, "Text:")(1), vbCr)(0))
  WkSht.Cells(r, 5).Value = Trim(Split(Split(StrTxt, "Date:")(1), vbCr)(0))
  WkSht.Cells(r, 6).Value = Trim(Split(Split(StrTxt, "Location:")(1), ",")(0))
  On Error GoTo 0
  strFile = Dir()
Wend
ErrExit:
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function
As coded, the macro processes all Word documents in the selected folder.

For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm. Although the instructions are for Word, it's essentially the same for Excel.

Do note that, after adding the macro, your workbook will need to be saved in the xls or xlsm format - not xlsx. Also, if you want to add more sermons, you should store those in a separate folder until they've been processed from that folder, then moved to your main folder.
 
Excellent. Thank you! I will plug that in and give it whirl.
 
Thanks for the assist! I was thinking something similar but you got to it b 4 me :)
 
Back
Top