|
Mailing List Parsing
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 |
Mailing List Parsing
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 |
| All times are GMT +1. The time now is 09:51 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com