If you have the database then I don't really see the problem. You can control
what comes out and where it comes from. Can't you? If however by database you
mean 'really big text file' then you are probably hooped because of potential
inconsistencies in the source data. What if there is no Country or postal
code. How about if the country is USA or US or U.S.A. Tough to pick out all
of the possibilities and shorthands... The program is going to have
difficulty handling inconsistent source data. Don't let me stop you from
trying though...

"Jim Berglund" wrote:

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