Has anyone ever created something that would grab data and sort it into various columns to create a file which could be imported into a mailing program like ACT or Outlook?

For Example: I have a database with several entries similar to the following two examples:



AND Products BV

Scheepmakersstraat 5

3011 VH Rotterdam ZH

The Netherlands

Phone: +31 10-885-1200

Fax: +31 10-885-1300

E-mail:

www.and.com





Appian Logistics Software, Inc.

10317 Greenbriar Place

Suite 100

Oklahoma City, OK 73159 USA

Phone: 800-893-1250

E-mail:

www.appianlogistics.com






I've been able to handle all the recognizable lines (the Name, in bold, the Phone, Fax, e-mail & website. But I'd like to know if anyone has figured out a way to parse out the city, state, zip & country, if & when they exist.





My working code, so far...



Private Sub CommandButton1_Click()

Dim i, j,m,k As Integer

i = 5

j = 5



m = InputBox("Enter First Data Row")

k = InputBox("Enter Last Data Row")

For i = m To k

If Cells(i, 1).Font.Bold = True Then

Cells(j, 2).Value = Cells(i, 1).Value

Cells(j, 3).Value = Cells(i + 1, 1).Value

Cells(j, 4).Value = Cells(i + 2, 1).Value

If Left(Cells(i + 3, 1).Value, 6) < "Phone:" Then

Cells(j, 5).Value = Cells(i + 3, 1).Value

End If

j = j + 1

Else

End If

Next

j = 5

For i = m To k

If Left(Cells(i, 1).Value, 6) = "Phone:" Then

Cells(j, 6).Value = Mid(Cells(i, 1).Value, 8, 80)

If Len(Cells(j, 6)) 12 Then

Cells(j, 6).Font.Bold = True

End If

j = j + 1

End If

Next

j = 5

For i = m To k

If Left(Cells(i, 1).Value, 4) = "Fax:" Then

Cells(j, 7).Value = Right(Cells(i, 1).Value, 12)

j = j + 1

Else

End If

Next

j = 5

For i = m To k

If Left(Cells(i, 1).Value, 4) = "E-ma" Then

Cells(j, 8).Value = Mid(Cells(i, 1).Value, 9, 99)

Cells(j, 8).Select

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="mailto:" + Cells(j, 8).Value, TextToDisplay:=Cells(j, 8).Value

j = j + 1

Else

End If

Next

j = 5

For i = m To k

If Left(Cells(i, 1).Value, 3) = "www" Then

Cells(j, 9).Value = Cells(i, 1).Value

Cells(j, 9).Select

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http://" + Cells(i, 9).Value, TextToDisplay:=Cells(j, 9).Value

j = j + 1

Else

End If

Next



End Sub



Many Thanks,





Jim Berglund

403-217-0768