Copy Email addresses from Word to Excel

[FIRSTROUNDKO]

HI!

I have a number of word document in the folder

C:\test

Can somebody please show me in a macro how I find email addresses in word and
extract to Excel

i.e Doc1 may have the address [email protected] and [email protected]
Doc2 may have the address [email protected]
etc

where would be the excel result

[email protected]
[email protected]
[email protected]

i think the pseudo code would be

open word document
find @
copy
paste to excel
offset(1,0)
find next @ in word document
close if no @ found
next Document

Thanks in Advance

 

[Doug Robbins - Word MVP]

Macro to extract all of the email addresses from a document

Sub CopyAddressesToOtherDoc()

Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add

Application.ScreenUpdating = False

Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="[+0-9A-z._-]{1,}\@[A-z.]{1,}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With

Selection.HomeKey Unit:=wdStory
Target.Activate

End Sub

To do this sort of thing with a bunch of documents, modify the code in the
article "Find & ReplaceAll on a batch of documents in the same folder" at:

http://www.word.mvps.org/FAQs/MacrosVBA/BatchFR.htm

to incorporate that shown above.


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[dirq]

A better regex is:

Sub CopyAddressesToOtherDoc()

Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add

Application.ScreenUpdating = False

Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find

'not a perfect regex..
Do While .Execute(findText:="[+0-9A-z._-]{1,}\@[0-9A-z._-]{1,}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With

Selection.HomeKey Unit:=wdStory
Target.Activate

End Sub

Macro to extract all of the email addresses from a document

Sub CopyAddressesToOtherDoc()

Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add

Application.ScreenUpdating = False

Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="[+0-9A-z._-]{1,}\@[A-z.]{1,}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With

Selection.HomeKey Unit:=wdStory
Target.Activate

End Sub

To do this sort of thing with a bunch of documents, modify the code in the
article "Find & ReplaceAll on a batch of documents in the same folder" at:

http://www.word.mvps.org/FAQs/MacrosVBA/BatchFR.htm

to incorporate that shown above.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

HI!

I have a number of word document in the folder

Can somebody please show me in a macro how I find email addresses in word
and
extract to Excel

i.e Doc1 may have the address [email protected] and [email protected]
Doc2 may have the address [email protected]
etc

where would be the excel result

i think the pseudo code would be

open word document
find @
copy
paste to excel
offset(1,0)
find next @ in word document
close if no @ found
next Document

Thanks in Advance

 

[Doug Robbins - Word MVP]

In what way? Seems to be the same to me except for the addition of a
comment.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

A better regex is:

Sub CopyAddressesToOtherDoc()

Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add

Application.ScreenUpdating = False

Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find

'not a perfect regex..
Do While .Execute(findText:="[+0-9A-z._-]{1,}\@[0-9A-z._-]{1,}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With

Selection.HomeKey Unit:=wdStory
Target.Activate

End Sub

Macro to extract all of the email addresses from a document

Sub CopyAddressesToOtherDoc()

Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add

Application.ScreenUpdating = False

Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="[+0-9A-z._-]{1,}\@[A-z.]{1,}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With

Selection.HomeKey Unit:=wdStory
Target.Activate

End Sub

To do this sort of thing with a bunch of documents, modify the code in
the
article "Find & ReplaceAll on a batch of documents in the same folder"
at:

http://www.word.mvps.org/FAQs/MacrosVBA/BatchFR.htm

to incorporate that shown above.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

HI!

I have a number of word document in the folder

Can somebody please show me in a macro how I find email addresses in
word
and
extract to Excel

i.e Doc1 may have the address [email protected] and [email protected]
Doc2 may have the address [email protected]
etc

where would be the excel result

i think the pseudo code would be

open word document
find @
copy
paste to excel
offset(1,0)
find next @ in word document
close if no @ found
next Document

Thanks in Advance

 

[dirq]

Doug - Thanks for the great code! It's helped us immensely!

The updated/hacked regex allows for email domains containing dashes,
etc. (see the 0-9 and the _ and - near the end)

[+0-9A-z._-]{1,}\@[0-9A-z._-]{1,}

There are better regexs for matching email addresses but it seems that
my version of word (2002 / SP3) won't accept most of them. See the
Regular Expression Library - Search for Email: http://regexlib.com/Search.aspx?k=email

Note: Since we are doing this to compile a list of bounced back emails
that we don't want to send to ever again this regular expression works
fine. It won't work for actually determining if this is a "valid"
email, just to get things that are like email addresses. See RFC 2822
for the real specs on email address formats: http://www.faqs.org/rfcs/rfc2822.html
(FYI: If you read this you are definitely a nerd).

Also, for those that stumble upon this posting. This is a WORD MACRO
and will create a new word document containing all of the email
addresses from the first doc in a list suitable for copying into
excel.

Dirk Watkins
www.dirq.net

In what way? Seems to be the same to me except for the addition of a
comment.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

A better regex is:

Sub CopyAddressesToOtherDoc()

Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add

Application.ScreenUpdating = False

Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find

'not a perfect regex..
Do While .Execute(findText:="[+0-9A-z._-]{1,}\@[0-9A-z._-]{1,}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With

Selection.HomeKey Unit:=wdStory
Target.Activate

End Sub

Macro to extract all of the email addresses from a document
Sub CopyAddressesToOtherDoc()
Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add
Application.ScreenUpdating = False
Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="[+0-9A-z._-]{1,}\@[A-z.]{1,}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With
Selection.HomeKey Unit:=wdStory
Target.Activate
End Sub
To do this sort of thing with a bunch of documents, modify the code in
the
article "Find & ReplaceAll on a batch of documents in the same folder"
at:
http://www.word.mvps.org/FAQs/MacrosVBA/BatchFR.htm
to incorporate that shown above.
--
Hope this helps.
Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.
Doug Robbins - Word MVP
HI!
I have a number of word document in the folder
C:\test
Can somebody please show me in a macro how I find email addresses in
word
and
extract to Excel
i.e Doc1 may have the address [email protected] and [email protected]
Doc2 may have the address [email protected]
etc
where would be the excel result
[email protected]
[email protected]
[email protected]
i think the pseudo code would be
open word document
find @
copy
paste to excel
offset(1,0)
find next @ in word document
close if no @ found
next Document
Thanks in Advance

 

[Doug Robbins - Word MVP]

Thanks, Dirk.

I was not aware of the Regular Expression Library and have done a bit of
"re-inventing the wheel" as a result

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Doug - Thanks for the great code! It's helped us immensely!

The updated/hacked regex allows for email domains containing dashes,
etc. (see the 0-9 and the _ and - near the end)

[+0-9A-z._-]{1,}\@[0-9A-z._-]{1,}

There are better regexs for matching email addresses but it seems that
my version of word (2002 / SP3) won't accept most of them. See the
Regular Expression Library - Search for Email:
http://regexlib.com/Search.aspx?k=email

Note: Since we are doing this to compile a list of bounced back emails
that we don't want to send to ever again this regular expression works
fine. It won't work for actually determining if this is a "valid"
email, just to get things that are like email addresses. See RFC 2822
for the real specs on email address formats:
http://www.faqs.org/rfcs/rfc2822.html
(FYI: If you read this you are definitely a nerd).

Also, for those that stumble upon this posting. This is a WORD MACRO
and will create a new word document containing all of the email
addresses from the first doc in a list suitable for copying into
excel.

Dirk Watkins
www.dirq.net

In what way? Seems to be the same to me except for the addition of a
comment.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

A better regex is:

Sub CopyAddressesToOtherDoc()

Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add

Application.ScreenUpdating = False

Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find

'not a perfect regex..
Do While .Execute(findText:="[+0-9A-z._-]{1,}\@[0-9A-z._-]{1,}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With

Selection.HomeKey Unit:=wdStory
Target.Activate

End Sub

On Jul 23, 9:51 pm, "Doug Robbins - Word MVP"
Macro to extract all of the email addresses from a document

Sub CopyAddressesToOtherDoc()

Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add

Application.ScreenUpdating = False

Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="[+0-9A-z._-]{1,}\@[A-z.]{1,}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With

Selection.HomeKey Unit:=wdStory
Target.Activate

End Sub

To do this sort of thing with a bunch of documents, modify the code in
the
article "Find & ReplaceAll on a batch of documents in the same folder"
at:

to incorporate that shown above.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

HI!

I have a number of word document in the folder

Can somebody please show me in a macro how I find email addresses in
word
and
extract to Excel

i.e Doc1 may have the address [email protected] and [email protected]
Doc2 may have the address [email protected]
etc

where would be the excel result

i think the pseudo code would be

open word document
find @
copy
paste to excel
offset(1,0)
find next @ in word document
close if no @ found
next Document

Thanks in Advance