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