I am using the programming below but can't get it to work on this type of
address:
Herrn
Guido Aulbach
Assessor jur.
Zürich Gruppe
Solmsstrasse 27-37
D-60252 Frankfurt am Main

Herrn
Ralph Brand
Senior Vice President
AIG Europe
Tour AIG
92079 Paris La Défense
2 Cedex
France

Sub ParseData()
'
' WORDTOEXCEL Macro
' Macro recorded 09/12/2007 by Adam Kelly
'

'
Dim r As Range, r1 As Range
Dim r2 As Range, rw As Long
Dim cell As Range, c As Range
Dim rng As Range
Dim i As Long, j As Long
Dim s As String, s1 As String
Dim s2 As String, s3 As String
Dim ipos1 As Long, ipos2 As Long
rw = 2
Set rng = Columns(1).SpecialCells(xlBlanks)
For Each cell In rng.Areas
Set r = cell(cell.Count).Offset(1, 0)
Set r1 = r.End(xlDown)
Set r2 = Range(r, r1)
j = 0
If r2.Rows.Count 7 Then Exit Sub
For Each c In r2
j = j + 1
Cells(rw, 3 + j) = c.Value
Next
Cells(rw, 3 + 1) = Trim(Replace _
(Cells(rw, 3 + 1), "", ""))
s = Cells(rw, 3 + j)
ipos1 = InStr(1, s, " ", vbTextCompare)
ipos2 = InStrRev(s, " ", -1, vbTextCompare)
s1 = Trim(Left(s, ipos1 - 1))
s2 = Trim(Mid(s, ipos1 + 1, ipos2 - ipos1))
s3 = Mid(s, ipos2 + 1, 255)
Cells(rw, 3 + j) = s1
Cells(rw, 3 + j + 1) = s2
Cells(rw, 3 + j + 2) = s3
rw = rw + 1
Next cell
End Sub

Can you tell me what is wrong with the language. Need to merge from word to
excel spreadsheet in order to import into database.

I've tried these resources with some great success:
http://gregmaxey.mvps.org/Extract_Form_Data.htm
http://word.mvps.org/faqs/interdev/c...xlfromword.htm
http://word.mvps.org/FAQs/InterDev/C...XLFromWord.htm

Regards,
Ryan---


--
RyGuy


"gwbdirect" wrote:

I am using the programming below but can't get it to work on this type of
address:
Herrn
Guido Aulbach
Assessor jur.
Zürich Gruppe
Solmsstrasse 27-37
D-60252 Frankfurt am Main

Herrn
Ralph Brand
Senior Vice President
AIG Europe
Tour AIG
92079 Paris La Défense
2 Cedex
France

Sub ParseData()
'
' WORDTOEXCEL Macro
' Macro recorded 09/12/2007 by Adam Kelly
'

'
Dim r As Range, r1 As Range
Dim r2 As Range, rw As Long
Dim cell As Range, c As Range
Dim rng As Range
Dim i As Long, j As Long
Dim s As String, s1 As String
Dim s2 As String, s3 As String
Dim ipos1 As Long, ipos2 As Long
rw = 2
Set rng = Columns(1).SpecialCells(xlBlanks)
For Each cell In rng.Areas
Set r = cell(cell.Count).Offset(1, 0)
Set r1 = r.End(xlDown)
Set r2 = Range(r, r1)
j = 0
If r2.Rows.Count 7 Then Exit Sub
For Each c In r2
j = j + 1
Cells(rw, 3 + j) = c.Value
Next
Cells(rw, 3 + 1) = Trim(Replace _
(Cells(rw, 3 + 1), "", ""))
s = Cells(rw, 3 + j)
ipos1 = InStr(1, s, " ", vbTextCompare)
ipos2 = InStrRev(s, " ", -1, vbTextCompare)
s1 = Trim(Left(s, ipos1 - 1))
s2 = Trim(Mid(s, ipos1 + 1, ipos2 - ipos1))
s3 = Mid(s, ipos2 + 1, 255)
Cells(rw, 3 + j) = s1
Cells(rw, 3 + j + 1) = s2
Cells(rw, 3 + j + 2) = s3
rw = rw + 1
Next cell
End Sub

Can you tell me what is wrong with the language. Need to merge from word to
excel spreadsheet in order to import into database.