I have a txt document full of descriptions of companies. Among other things, the listings include email addresses. I want to write a Macro that tells Word to cull the email addresses out of that document and paste them into a new one, creating a list of email addresses.
I should say at this point that I am not spamming these people; the email I send will be welcomed and I have permission to use the list - that is what it is for.
I recorded a Macro that finds the address:
Sub contacts()
'
' contacts Macro
' Macro recorded 01/10/01 by sdimbert
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "contact:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
End Sub
Here is a sample of the text (modified for privacy):
<HR>
<H2 align="center"><A name=XXXXXXX></A>XXXXXXX</H2>
<CENTER>XXXXXXX offers quality services that build customer
relationships through
both inbound <br>
customer service as well as traditional outbound market research.
(20 stations)
<P><I>Specialties</I>: Advertising | Business-to-Business
| Consumer | Executive
| High Tech | Medical
<P><I>Other Services</I>: Coding | Tabulation
<P>
<table border="0" width="100%">
<tr>
<td width="33%">
<h5 align="center">Contact: Joe Smith<br>
<A href="mailto:smith@ XXXXXXX.com">Company e-mail</A></h5>
</td>
<td width="33%">
<h5 align="center">800 Anystreet, Suite 100<br>
Anytown, ST 54321-1234</h5>
</td>
<td width="34%">
<h5 align="center">123/456-7890<br>
123/098-7654 fax</h5>
</td>
</tr>
</table>
So, when I run the Macro, word finds the next time the text “Contact:” appears. What I need it to do is then copy the next section of tect, which is a <a href=“mailto:”> statement which includes the email address.
Once I have those <a href>'s, I know how to use Excel to parse out the email address. It’s the Macro/Visual Basic programming in Word that has me stuck.
Anyone feeling helpful?
[Edited by Alphagene on 01-10-2001 at 03:54 PM]
Ooops! :eek:
Would a Mod please add a line break somewhere between the second set of {CODE} tags, please?
Seeing as it is approaching midnight and I am stuck at work waiting on some other people (I got here at 9 a.m.), I decided to give you a little free programming. This is on the condition that you have received permission to use the addresses that you will be parsing with my macro. I put this together pretty quickly; it’s not all that elegant and it is completely lacking in exception handling. As always, use at your own risk, but I would like to know how things turn out (Hamlet_37@yahoo.com). Good luck.
Function GetEndPosition(sRightText As String) As Long
With Selection.Find
.Text = sRightText
.Forward = True
.Wrap = wdFindStop
End With
Selection.Find.Execute
If (Selection.Find.Found) Then
Selection.MoveLeft wdCharacter, 1
GetEndPosition = Selection.Range.Start
Else
GetEndPosition = -1
End If
End Function
Function GetStartPosition(sLeftText As String) As Long
With Selection.Find
.Text = sLeftText
.Forward = True
.Wrap = wdFindStop
End With
Selection.Find.Execute
If (Selection.Find.Found) Then
Selection.MoveRight wdCharacter, 1
GetStartPosition = Selection.Range.Start
Else
GetStartPosition = -1
End If
End Function
Sub ParseContactList()
Dim docRawData As Document
Dim docContactList As Document
Dim lPosition1 As Long
Dim lPosition2 As Long
Dim sName As String
Dim sAddress As String
Set docRawData = ActiveDocument
Set docContactList = Documents.Add
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Do
docRawData.Activate
lPosition1 = GetStartPosition(">Contact:")
lPosition2 = GetEndPosition("<")
If ((lPosition1 = -1) Or (lPosition2 = -1)) Then Exit Do
sName = Trim(ActiveDocument.Range(lPosition1, lPosition2))
lPosition1 = GetStartPosition("<A href=""mailto:")
lPosition2 = GetEndPosition(""">")
If ((lPosition1 = -1) Or (lPosition2 = -1)) Then Exit Do
sAddress = Trim(ActiveDocument.Range(lPosition1, lPosition2))
docContactList.Activate
Selection.TypeText (sName & vbTab & sAddress & vbCrLf)
Loop While (Selection.Find.Found)
Selection.HomeKey Unit:=wdStory
End Sub
Hamlt,
First of all, you’re awesome! 
Second of all, yes, I have permission. Never you mind… everything is kosher.
Third of all, it doesn’t work. 
Well, that’s not quite accurate. I copied the text you supplied and pasted it into a new macro called “Hamlet.” When I tried to run it, I got an error saying, “Could not find Macro Storage.” Now, I don’t know very much, so I can’t decipher the error.
Can anyone help?
sdimbert-
Are you, by chance, running WindowsNT or Windows 2000? My first guess would be that you do not have the necessary rights. This is a Microsoft Word error, not a problem with the macro itself. I’ve tried it on several machines (Win2000, Win98, and WinMe) and it works as it is supposed to. You might ask your IT department for help, or consult the following articles.
[ul]
[li]Q212669[/li][li]Q224338[/li][li]Q247028[/li][li]Q264743[/li][/ul]
If all else fails, run it on another machine or logged in as another user. Good luck!
Again, thank you.
I don’t think the problem is anything as elaborate as what you’ve described. I’m using Word in Win98 on my own PC. Yes, I am in a networked environment, but I am the only person using these macros… everything is local.
I probably didn’t install all of the parts needed to run macros when I installed Word. Or something like that.
Could you possible write up some dummy directions on how I am to get the script from your post into a Macro? I mean, I know how to copy and paste, but how do I create a place to paste the text, name it, save it… etc. That seems to be what is hanging me up.
Thanks, again and again!