How do I mass-extract email addresses out of several word documents at once?

Anonymous
2011-07-17T15:24:20+00:00

Hello All,

I have an important question.

How do I mass-extract email addresses out of several word documents at once?

I have a folder saved on my desktop with about 12000 word documents. All these documents have an email address in them but I want to know how to export all these email addresses without opening every single file one by one.

I hope somebody can help.

Kind regards,

EM

Microsoft 365 and Office | Word | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments
Answer accepted by question author
Anonymous
2011-07-18T05:02:41+00:00

It is not possible to extract the e-mail addresses without opening the documents, but the process can be automated with a macro. The following may do what you want, so try it on a folder containing ONLY a small subset of the documents before attempting to try it on a huge number of files. The following macro will extract any e-mail address in the documents and write them, one to a line, to a new document. It will not make any permanent changes to the documents themselves.

NOTE: IT WILL CRASH IF ANY OF THE DOCUMENTS ARE PASSWORD PROTECTED

http://www.gmayor.com/installing_macro.htm

Sub BatchProcess()

Dim strFilename As String

Dim strPath As String

Dim oDoc As Document

Dim oNewDoc As Document

Dim oRng As Range

Dim hLink As Hyperlink

Dim fDialog As FileDialog

Set oNewDoc = Documents.Add

Options.AutoFormatReplaceHyperlinks = True

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog

    .Title = "Select folder containing the documents and click OK"

    .AllowMultiSelect = False

    .InitialView = msoFileDialogViewList

    If .Show <> -1 Then

        MsgBox "Cancelled By User", , _

               "List Folder Contents"

        Exit Sub

    End If

    strPath = fDialog.SelectedItems.Item(1)

    If Right(strPath, 1) <> "" _

       Then strPath = strPath + ""

End With

If Left(strPath, 1) = Chr(34) Then

    strPath = Mid(strPath, 2, Len(strPath) - 2)

End If

strFilename = Dir$(strPath & "*.doc?")

While Len(strFilename) <> 0

    WordBasic.DisableAutoMacros 1

    Set oDoc = Documents.Open(strPath & strFilename)

    oDoc.Range.AutoFormat

    For Each hLink In oDoc.Hyperlinks

        If InStr(1, hLink.Address, "@") Then

            oNewDoc.Range.InsertAfter hLink.Range & vbCr

        End If

    Next hLink

    oDoc.Close SaveChanges:=wdDoNotSaveChanges

    WordBasic.DisableAutoMacros 0

    strFilename = Dir$()

Wend

oNewDoc.Paragraphs.Last.Range.Delete

oNewDoc.Range.Sort

oNewDoc.Range.Find.Execute FindText:="(*^13)@", _

                           MatchWildcards:=True, _

                           ReplaceWith:="\1", _

                           Replace:=wdReplaceAll

End Sub

Was this answer helpful?

10+ people found this answer helpful.
0 comments

45 additional answers

Sort by: Newest
Most helpful Newest Oldest
  1. Anonymous
    2013-08-26T23:53:33+00:00

    I am sorry friend, you just lost me. Are you referring to like "Find and Replace" in word? also, the ^phttp and ^thttp are greek to me. Please elaborate if you dont mind.

    Was this answer helpful?

    0 comments
  2. Doug Robbins - MVP - Office Apps and Services 323.6K Reputation points MVP Volunteer Moderator
    2013-08-26T22:25:31+00:00

    The next thing that you should do (or it could be incorporated into the code is use the replace facility to replace

    ^phttp

    with

    ^thttp

    That will insert a tab space between the title and the url and you can then use the Convert Text to Table facility to convert everything into a table which can then be copied into Excel and then from Excel you can copy it and paste it into Access.

    Was this answer helpful?

    0 comments
  3. Anonymous
    2013-08-26T19:32:16+00:00

    That's it! Works perfect.. Fast too. I really want to thank both of you guys (Doug and Graham.) Your help is sincerely appreciated. I cannot even begin to tell you how much time you guys saved me with this. You guys are both just too smart. Kudos! Now, I will try to figure out a way to suck the results into a simple Access database or something.

    Just FYI, I am doing this to save myself even more time when doing research for stuff I write. I have spend untold hours doing the research and getting the links, and I find myself using many of the same links again and again in some cases. Would be really sweet if I could just dump them all in a simple Access DB and search for them as needed. Maybe even create some sort of clickable "Paste to current position in Word" or something. But, one step at a time. This was the biggest hurdle for me I think.

    The search feature in Windows works okay, but it just returns too many full document links. I think extracting just the links and entering them into an access DB or maybe even a spreadsheet will work better for me.

    Anyway, thanks again guys., You're the best!

    Jeff

    Was this answer helpful?

    0 comments
  4. Anonymous
    2013-08-26T11:08:57+00:00

    I suspect if you add-in the bold bits it should work.

    For Each hLink In oDoc.Hyperlinks

                If InStr(1, LCase(hLink.Address), "http") > 0 And _               InStr(1, LCase(hLink.Address), "google") = 0 Then

                    Set rngGet = hLink.Range

                    rngGet.MoveStart wdParagraph, -1

                    oNewDoc.Range.InsertAfter rngGet & vbCr

                End If

    Next hLink

    Was this answer helpful?

    0 comments