Create a VBA macro to parse the provided sample Word document to Excel

[Boky]

Hello guys,

I have tried to find a solution but un succeeded so far. I need to copy the entire text from a Word file to an Excel file, Sheet1 using VBA macros and I need to follow this set of rules:

* Heading 1 needs to be UPPERCASE
* Heading 2 and 3 need to be bold and underlined.

I really appreciate any help you can provide. I'm new here with VBA so I very appreciate your help.

 

[Macropod]

Did you set a VBA reference to Word, as per the note at the top of the code?

 

[Boky]

Yes, I did set it all.

 

[Boky]

The code is working
On the first try, I forgot to set the document address in a folder. So I have one more issue, how to remove empty rows, so the text will paste in A1, A2, A3, A4....

 

[Boky]

And that font tyle formating for Heading1 it's not returning Allcaps as you can see in A1 cell. Do you maybe know why is this happening? I tried with the UCase function and it's not working also.

 

[Macropod]

And that font tyle formating for Heading1 it's not returning Allcaps as you can see in A1 cell. Do you maybe know why is this happening? I tried with the UCase function and it's not working also.

Hmm, it seems the AllCaps property doesn't carry over when copying. Code updated below.

So I have one more issue, how to remove empty rows, so the text will paste in A1, A2, A3, A4....

That's what happens when someone has badly formatted the document, using empty paragraphs instead of before/after spacing to control the space between paragraphs. Code updated below.

Sub GetWordData()
'Note: this code requires a reference to the Word object model. See under the VBE's Tools|References.
Application.ScreenUpdating = False
Const strFile As String = "Document path & filename"
If Dir(strFile) = "" Then MsgBox "strFile" & vbCr & "Not Found. Exiting.", vbInformation: End
Dim wdApp As New Word.Application, wdDoc As Word.Document, WkSht As Worksheet, c As Long, r As Long
Set WkSht = ActiveSheet
Set wdDoc = wdApp.Documents.Open(Filename:=strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
  With .Range
    .ListFormat.ConvertNumbersToText
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .Forward = True
      .Wrap = wdFindContinue
      .MatchWildcards = True
      .Text = "([^13^l]){2,}"
      .Replacement.Text = "\1"
      .Execute Replace:=wdReplaceAll
      .Text = "^t"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
      .Text = ""
      .Replacement.Text = ""
      .Style = wdStyleHeading1
      .Wrap = wdFindStop
    End With
    Do While .Find.Execute
      .Text = UCase(.Text)
      .Collapse wdCollapseEnd
      If .End = wdDoc.Range.End Then Exit Do
    Loop
  End With
  .Styles(wdStyleHeading2).Font.Bold = True
  .Styles(wdStyleHeading2).Font.Underline = wdUnderlineSingle
  .Styles(wdStyleHeading3).Font.Bold = True
  .Styles(wdStyleHeading3).Font.Underline = wdUnderlineSingle
  .Range.Copy
  WkSht.Paste Destination:=WkSht.Range("A1")
  .Close SaveChanges:=False
End With
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

 

[Boky]

Hey man, I really appreciate your effort to help, but, I don't have enough knowledge even to copy the code. I got the error again with the updated code (some OLE error after minutes of waiting). So. I will use the first code you wrote and try to make some changes. And I will send that assignment to the company.

 

[Macropod]

I got the error again with the updated code (some OLE error after minutes of waiting). So. I will use the first code you wrote and try to make some changes. And I will send that assignment to the company.

Did you remember to set the document name & address? It's also possible you have an orphaned Word session, which you'll need to terminate via the Task Manager.

 

[Boky]

Yes, I set the address and doc name this time
I'll try ending the word session in task manager. Thanks again.

 

[Boky]

The task manager is the key.

You are the man, thanks a lot!!!!!!!

Now I need to export .dotm macro file and send via email and wait for the interview

 

[Macropod]

I can't see what the above has to do with a Word .dotm file - the macro goes into an Excel .xlsm file.

I do hope you're not trying to pass the code off as your own solution to a problem for job interview purposes...