none
Recording a macro of extracting all Email addresses in a document,but it doesn't work RRS feed

  • Question

  • Hi,all

    I extract all Email addresses in a document using  the function of "Find" and record the process as a macro.But the macro can't run successfully.

    I want to know why the macro coming from  "Record macro" didn't work while all steps get work in recording.I'm using word 2010.I had asked this question in Word IT Pro Discussions Forum, and Mr Steven told me to ask here. Any help will be appreciated. 

    Here are the steps to extract all Email addresses:

    1.Click "Record macro" in "Developer".

    2.Open the "Find and Replace"panel.

    3.Type “[A-z,0-9]{1,}\@[A-z,0-9,\.]{1,}” in Find what, and check “Use wildcards”,the click "Find In"-->"Main Document"

    4.Then copy all selected emails and paste them to a new document

    5.Click "Stop Recording"

    Here are the macro codes

    Sub Macro1()
    '
    ' Macro1 Macro
    '
    '
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "[A-z,0-9]{1,}\@[A-z,0-9,\.]{1,}"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
        End With
        Selection.Copy
        Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
        Selection.PasteAndFormat (wdFormatPlainText)
    End Sub

    When I run the macro ,it shows:

    Run-time error'4605':

    This method or property is not available because no text is selected.



    • Edited by JO1221 Tuesday, January 3, 2017 8:15 AM
    Tuesday, January 3, 2017 3:56 AM

Answers

  • Hi,

    Add .Execute before End With to execute the find.

    Sub Macro2()
    '
    ' Macro2 Macro
    '
    '
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "[A-z,0-9]{1,}\@[A-z,0-9,\.]{1,}"
            .Replacement.Text = ";"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
            .Execute
        End With
        Selection.Copy
        Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
        Selection.PasteAndFormat (wdFormatPlainText)
    End Sub
    

    Regards,

    Celeste



    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by JO1221 Wednesday, January 4, 2017 5:08 AM
    Tuesday, January 3, 2017 7:24 AM
    Moderator
  • The code I posted in the other thread only extracts a single record because that's all your own code could have done and I was showing how to fix the inherent problems with it. For whatever reason, even here you ignored the advice I gave there about the need to add '.Execute' to your own code...

    If you want to extract all email addresses from a document you could use:

    Sub Demo()
    Dim StrEmails As String
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "<[A-z0-9.]@\@[A-z0-9]@.[A-z0-9]@>"
        .Replacement.Text = ""
        .Format = False
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Execute
      End With
      Do While .Find.Found
        StrEmails = StrEmails & .Text & vbCr
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    If StrEmails <> "" Then
      Documents.Add Template:="Normal"
      ActiveDocument.Range.Text = StrEmails
    End If
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Tuesday, January 3, 2017 10:19 AM Coding error
    • Marked as answer by JO1221 Wednesday, January 4, 2017 5:08 AM
    Tuesday, January 3, 2017 10:07 AM

All replies

  • Hi,

    Add .Execute before End With to execute the find.

    Sub Macro2()
    '
    ' Macro2 Macro
    '
    '
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "[A-z,0-9]{1,}\@[A-z,0-9,\.]{1,}"
            .Replacement.Text = ";"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
            .Execute
        End With
        Selection.Copy
        Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
        Selection.PasteAndFormat (wdFormatPlainText)
    End Sub
    

    Regards,

    Celeste



    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by JO1221 Wednesday, January 4, 2017 5:08 AM
    Tuesday, January 3, 2017 7:24 AM
    Moderator
  • Hi,Celeste

    Thank you so much for your answer! It really works!

    But it can only extract one Email address rather than all of them.Any suggestions?

    Best regards

    Tuesday, January 3, 2017 8:48 AM
  • Hi,Paul

    Thanks for your comment.

    I had tried your macro.The first time it got error 4605 as I replied in that post.

    Now I tried it again,and it suddenly works ,but it can only extract one Email address rather than all.

    Best regards

    Tuesday, January 3, 2017 9:08 AM
  • The code I posted in the other thread only extracts a single record because that's all your own code could have done and I was showing how to fix the inherent problems with it. For whatever reason, even here you ignored the advice I gave there about the need to add '.Execute' to your own code...

    If you want to extract all email addresses from a document you could use:

    Sub Demo()
    Dim StrEmails As String
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "<[A-z0-9.]@\@[A-z0-9]@.[A-z0-9]@>"
        .Replacement.Text = ""
        .Format = False
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Execute
      End With
      Do While .Find.Found
        StrEmails = StrEmails & .Text & vbCr
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    If StrEmails <> "" Then
      Documents.Add Template:="Normal"
      ActiveDocument.Range.Text = StrEmails
    End If
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Tuesday, January 3, 2017 10:19 AM Coding error
    • Marked as answer by JO1221 Wednesday, January 4, 2017 5:08 AM
    Tuesday, January 3, 2017 10:07 AM
  • Hi,Paul

    I tried this and extracted all email addresses.Thank you very much for your time and information.It is very useful!

    best regards

    Wednesday, January 4, 2017 5:08 AM