Import complicated data from word to excel

Hi all

I am new to this forum and i have been trying some other threads importing word data to excel but finding code to help me extract this numbers keeps me struggling...


Basically: I have 10 word documents that contain the same data for different location.. I have a sample word input and a sample excel output.

I tried my best but my best wasn't good enough..

any help much appreciated..

thanks so much

See the attached workbook. It contains a macro named 'GetData'. Run that. Note that the macro includes a browser, so all you need to do is to point it to the folder containing the Word files.

i went to tools and references and i found out that
MISSING: Microsoft Word 14.0 Object Library

what should i do :(

im using microsoft 2007 and i saw on the reference is Microsoft Word 12.0 Object Library is present

now at the moment, i am downloading microsoft 2010 for this project to be tested and run.

I have tried it on microsoft 2010 and it worked!! flawless!
Thank you so much macropod!! many many thanks!
Im so glad :yes:yes
cheers for you sir :beerchug:

Actually, the code won't be 'flawless' just yet - you need to change:

Code:

---

  strFile = Dir()
Wend
wdApp.Quit
With xlWkSht
  .Cells(LRow + 1, 1).Value = .Cells(LRow, 6).Value
  .Cells(LRow, 6).Value = .Cells(LRow, 5).Value
  .Cells(LRow, 5).Value = .Cells(LRow, 4).Value
  .Cells(LRow, 4).Value = .Cells(LRow, 7).Value
  .Cells(LRow + 1, 5).Value = .Cells(LRow, 10).Value
  .Cells(LRow, 10).Value = vbNullString
  .Cells(LRow + 1, 6).Value = .Cells(LRow, 11).Value
  .Cells(LRow, 11).Value = vbNullString
  .Range("G1:K1").EntireColumn.Delete
  .Range("B1:B" & LRow).Value = .Range("B1:K" & LRow).Value
  .Range("A1:H1").EntireColumn.AutoFit
End With

---

to:

Code:

---

  With xlWkSht
    .Cells(LRow + 1, 1).Value = .Cells(LRow, 6).Value
    .Cells(LRow, 6).Value = .Cells(LRow, 5).Value
    .Cells(LRow, 5).Value = .Cells(LRow, 4).Value
    .Cells(LRow, 4).Value = .Cells(LRow, 7).Value
    .Cells(LRow + 1, 5).Value = .Cells(LRow, 10).Value
    .Cells(LRow, 10).Value = vbNullString
    .Cells(LRow + 1, 6).Value = .Cells(LRow, 11).Value
    .Cells(LRow, 11).Value = vbNullString
    .Range("G1:K1").EntireColumn.Delete
    .Range("B1:B" & LRow).Value = .Range("B1:K" & LRow).Value
    .Range("A1:H1").EntireColumn.AutoFit
  End With
  LRow = LRow + 1
  strFile = Dir()
Wend
wdApp.Quit

---

Or perhaps:

Code:

---

With xlWkSht
    .Cells(LRow + 1, 1).Value = .Cells(LRow, 6).Value
    .Cells(LRow, 6).Value = .Cells(LRow, 5).Value
    .Cells(LRow, 5).Value = .Cells(LRow, 4).Value
    .Cells(LRow, 4).Value = .Cells(LRow, 7).Value
    .Cells(LRow + 1, 5).Value = .Cells(LRow, 10).Value
End With
LRow = LRow + 1
strFile = Dir()
Wend
With xlWkSht
    .Range("G1:K1").EntireColumn.Delete
    .Range("B1:B" & LRow).Value = .Range("B1:K" & LRow).Value
    .Range("A1:H1").EntireColumn.AutoFit
End With
wdApp.Quit

---

Re your comment about 'MISSING: Microsoft Word 14.0 Object Library'. For Office 2007, simply replace the reference with one to the Microsoft Word 12.0 Object Library.

thanks i would try those out right now. brb

im now using ms 2010 :)

I added a row to distinguish each file

Code:

---

End With
LRow = LRow + 2
strFile = Dir()
Wend

---

together with the code above this is the output file. I noticed that the distance though was not on the right cell on the last 2nd line of each file

Sorry about that. I hadn't fully allowed for the fact my code outputs the data with a different column order to what you originally posted. The following changes should put the data for the penultimate and last rows in each block in the correct columns.

Code:

---

  With xlWkSht
    .Cells(LRow + 1, 1).Value = .Cells(LRow, 6).Value
    .Cells(LRow, 6).Value = .Cells(LRow, 7).Value
    .Cells(LRow + 1, 4).Value = .Cells(LRow, 10).Value
    .Cells(LRow + 1, 5).Value = .Cells(LRow, 11).Value
  End With
  strFile = Dir()
  LRow = LRow + 2
Wend
With xlWkSht
  .Range("G1:K1").EntireColumn.Delete
  .Range("B1:B" & LRow).Value = .Range("B1:F" & LRow).Value
  .Range("A1:F1").EntireColumn.AutoFit
End With
wdApp.Quit

---

thank you so much! i wish i could learn how you did that so i too can make my own vba script in the future.

i got another sample here. what i did was convert doc to txt then to xls space delimeted and deleted and moved some cells.


thank you :yes

can you create a macro for this too

Try the attached. FWIW, most of the code in both solutions involve using Word's wildcard Find/Replace functions. You can learn and use those without having to learn VBA.

what if i'd like to autofill the first row without altering its numbering to make that like the one below
e.g.

before	after
S-50=PPM 18	S-50=PPM 18
	S-50=PPM 18
	S-50=PPM 18
S-51	S-51
	S-51
	S-51
	S-51
S-52=HUB	S-52=HUB
	S-52=HUB
	S-52=HUB
S-55=HUB	S-55=HUB
	S-55=HUB
	S-55=HUB

i will try to learn from those codes the best as i can :yes
and thank you for the time sir :bow:

Change:

Code:

---

With xlWkSht
  .Range("A1:F1").EntireColumn.AutoFit
  .Range("A1").ActivateWith xlWkSht
End With

---

to:

Code:

---

With xlWkSht
  .Range("A1:F1").EntireColumn.AutoFit
  .Range("A1").ActivateWith xlWkSht
  For LRow = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
    If .Cells(LRow, 2).Value <> "" Then
      If .Cells(LRow, 1).Value = "" Then
        .Cells(LRow, 1).Value = .Cells(LRow - 1, 1).Value
      End If
    End If
  Next
End With

---

PS: You can delete the workbook's 'module1' code module - it's not needed and merely contains some left-over development code.

It worked :yes. Just modded some changes to the code. This is the last request ill made for this thread ^^
can you add a code that will add the Case to the next cell right to the last column just beside the easting but heading not included : pray2:

Before		After
Eastings		Eastings
478,277.413		478,277.413	Case 5
478,440.471		478,440.471	Case 5
478,200.645		478,200.645	Case 5
478,440.471		478,440.471	Case 5
478,277.413		478,277.413	Case 5

There seems to be some serious scope creep going on here ...

Change the final 'With xlWkSht ... End With' block to:

Code:

---

With xlWkSht
  .Range("A1:F1").EntireColumn.AutoFit
  .Range("A1").Select
  For LRow = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
    If .Cells(LRow, 2).Value <> "" Then
      If .Cells(LRow, 1).Value = "" Then
        .Cells(LRow, 1).Value = .Cells(LRow - 1, 1).Value
      End If
    End If
    If .Cells(LRow, 1).Value = "CASE" Then
      StrOut = "CASE " & .Cells(LRow, 2).Value
    ElseIf IsNumeric(.Cells(LRow, 6).Value) = True Then
      If .Cells(LRow, 6).Value <> "" Then .Cells(LRow, 7).Value = StrOut
    End If
  Next
End With

---

I'm so sorry for the inconvenience. i thought of making a new thread for the other kinds of help that was far off and new maybe, but i put it here. sorry.
Thank you sir for everything and thanks for the inspiration. Bless you and advanced merry Christmas! :)

hello macropod, is it ok if i add another sample.. i feel like i would :banghead:

Macro, i learned and somehow tried my best. All is well.
The only lacking data now is the Area and i cant get rid of the first empty column beside the numbers.

:yes

Update: I have successfully and flawlessly extracted all the data and put them into the right places. Wildcard really "is" interesting.
The problem was solved. Thanks Macropod for the inputs :beerchug: