Word doc to excel

macropod · #6 10-02-2013, 05:46 AM

If the data had been as you previously described, and perhaps only lacked 'Address 2' for some records, it could have been extracted and exported to Excel will little or no post-processing clean-up required. However, what you've posted suggests some records may or may not have 'Address 3', 'Town' and 'Country' fields as well. Consequently, where there are less than the maximum of 8 data lines, there is no way a macro could reliably differentiate between records that lack 'Address 2', and/or 'Address 3' and/or 'Town' and/or 'Country'. Therefore, a considerable amount of post-processing cleanup is likely to be required.

Some of your cells also have extraneous empty paragraphs before/after the data.

It's also still not clear from what you've posted as to whether the names need to be split in any way (eg title, initials, surname) and, if so, how variable the data in that row are.

Here is a macro that extracts the table data and outputs it as a text file in the CSV format. Excel should be able to open that directly. As previously mentioned, though, you may need to do a fair bit of manual post-processing. Note, too, that the code modifies your document as well, so you might want to close it without saving the changes (which reflect the way the data will be exported to Excel) after the csv file is created.

Code:

Sub Export()
Dim i As Long, j As Long, k As Long, Rng As Range
Dim DataFile As String, StrData As String
DataFile = "C:\Users\" & Environ("UserName") & "\Documents\Data.CSV"
StrData = "Name,Address 1,Address 2,Address 3,Town,City,PostCode,Country" & vbCr
With ActiveDocument
  With .Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[^13]{2,}"
    .Replacement.Text = "^p"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  With .Tables(1).Range
  For i = 1 To .Cells.Count
    Set Rng = .Cells(i).Range
    With Rng
      .End = .End - 1
      If .Start <> .End Then
        If Len(Trim(.Paragraphs(1).Range.Text)) < 3 Then .Paragraphs(1).Range.Text = vbNullString
        k = .Paragraphs.Count
        For j = k To 6
          .Paragraphs(Int(k / 2)).Range.InsertAfter vbCr
        Next
      End If
      StrData = StrData & Replace(.Text, vbCr, ",") & vbCr
    End With
  Next
  StrData = Replace(Replace(StrData, Chr(12), vbNullString), vbCr & vbCr, vbCr)
  MsgBox StrData
  End With
End With
Open DataFile For Output As #1
Print #1, StrData
Close #1
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Excel to Word	Hinchy	Excel	1	09-07-2012 08:12 PM
Can this be fix in excel or should I go to word	lostsoul62	Excel	1	04-18-2012 01:00 AM
Open Word w Excel & fill Word textboxes w info from Excel fields runtime error 4248	Joe Patrick	Word VBA	2	01-30-2012 07:23 AM
Word to Excel	rynman	Office	5	04-19-2009 06:50 AM
Excel to Word	retrospect1984	Excel	1	02-18-2009 06:41 AM