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: Most helpful
Most helpful Newest Oldest
  1. Doug Robbins - MVP - Office Apps and Services 323.6K Reputation points MVP Volunteer Moderator
    2015-06-13T12:48:35+00:00

    No.  It is designed to be run from Word where it will create a new document into which it will insert the email addresses from the Excel Workbook(s).

    Was this answer helpful?

    0 comments
  2. Anonymous
    2015-06-13T11:50:38+00:00

    Hey Doug, you mean the macro is intended to be used in excel I suppose?

    Is there a way to make it work without the mails being in column F but for example in column A,B,C,D,E,F for example? I guess it's just repeating a part of the code?

    Kind regards,

    Chip

    Was this answer helpful?

    0 comments
  3. Doug Robbins - MVP - Office Apps and Services 323.6K Reputation points MVP Volunteer Moderator
    2015-06-12T03:33:00+00:00

    The following macro is intended to be used in Word, and it will only work if the email addresses in the various workbooks are in column F of the first Worksheet:

    Sub BatchProcess()

    Dim strFilename As String

    Dim strPath As String

    Dim oNewDoc As Document

    Dim fDialog As FileDialog

    Dim xlApp As Object

    Dim xlbook As Object

    Dim xlsheet As Object

    Dim i As Long

    Dim strEmail As String

    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 & "*.xls?")

    Set xlApp = CreateObject("Excel.Application")

    While Len(strFilename) <> 0

        With xlApp

            Set xlbook = .Workbooks.Open(strPath & strFilename)

            With xlbook.Sheets(1)

                For i = 1 To .UsedRange.Rows.Count

                    With .Range("A1")

                        If .Offset(i, 5) <> "" Then

                            strEmail = strEmail & vbCr & .Offset(i, 5)

                        End If

                    End With

                Next i

            End With

            xlbook.Close SaveChanges:=False

        End With

        strFilename = Dir$()

    Wend

    Set xlbook = Nothing

    xlApp.Quit

    Set xlApp = Nothing

    strEmail = Mid(strEmail, 2)

    oNewDoc.Range.Text = strEmail

    End Sub

    Was this answer helpful?

    0 comments
  4. Anonymous
    2015-06-11T06:52:04+00:00

    Hey Doug,

    Sorry I'm new to ths all. I put the excel in a folder and shared the folder. So I hope the link to the folder works now and that you can open the excel.

    https://onedrive.live.com/redir?resid=114309156909a90e!114&authkey=!AN3xQdNe55xKBZE&ithint=folder%2cxls

    Thanks,

    Chip

    Was this answer helpful?

    0 comments