Results 1 to 7 of 7
  1. #1
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    Can a macro look through a Word doc (if so, now?) to find all numbers of the form xx-xxxx and extract those to, say, an Excel file?

    For example:

    Car boat office 45678 Freind neighbor 01-5555 house Freind neighbor 01-5565 house Freind neighbor 01-6655 house Freind neighbor 01-9855 house Freind neighbor 02-8755 house Freind neighbor 08-5355 house

    01-5555
    01-5565
    01-6655
    etc. (but NOT the number shown as 45678)

  2. #2
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts
    [quote name='kweaver' post='792050' date='03-Sep-2009 17:34']Can a macro look through a Word doc (if so, now?) to find all numbers of the form xx-xxxx and extract those to, say, an Excel file?[/quote]
    You can use Word's wildcard find feature. First, design the find query interactively so that you know it works correctly. Then record a macro of conducting the find. Then edit the macro so that after each successful find, the macro takes the action you want it to take. I'm not very familiar with automating Excel, but I'm sure you can find examples.

    I may have a few moments to tackle this, but I imagine others might jump in.

    === Edit ===

    Here's a "proof of concept" for the wildcard search loop approach:

    [codebox]Sub FindPatternTEST()
    Dim strSample As String
    strSample = "Found:" & vbCrLf
    With Selection
    .HomeKey wdStory
    With .Find
    .ClearFormatting
    .Text = "[0-9]{2}-[0-9]{4}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True 'Essential!
    End With
    While .Find.Execute
    ' Found string is selected; do stuff here
    strSample = strSample & .Text & vbCrLf
    Wend
    .Find.MatchWildcards = False 'Politely return to normal
    End With
    MsgBox strSample
    End Sub[/codebox]
    I've read that it's more efficient to work with ranges rather than with the selection object. Since it is easier to record and to debug using the Selection object, that's where I started. If performance becomes an issue (e.g., huge document), then you could optimize it further.

  3. #3
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    I used the wildcard feature in FIND and can highlight those I want, but cannot then copy them to ultimately paste them in to Excel. Closing the FIND dialog box deselects those I found, unfortunately. I'm doing this in 2003; maybe 2007 treats it differently and I'll try that. If someone else has another approach, it would be appreciated.

    Thanks,

    Kevin

    [quote name='jscher2000' post='792053' date='03-Sep-2009 20:50']You can use Word's wildcard find feature. First, design the find query interactively so that you know it works correctly. Then record a macro of conducting the find. Then edit the macro so that after each successful find, the macro takes the action you want it to take. I'm not very familiar with automating Excel, but I'm sure you can find examples.

    I may have a few moments to tackle this, but I imagine others might jump in.

    === Edit ===

    Here's a "proof of concept" for the wildcard search loop approach:

    [codebox]Sub FindPatternTEST()
    Dim strSample As String
    strSample = "Found:" & vbCrLf
    With Selection
    .HomeKey wdStory
    With .Find
    .ClearFormatting
    .Text = "[0-9]{2}-[0-9]{4}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True 'Essential!
    End With
    While .Find.Execute
    ' Found string is selected; do stuff here
    strSample = strSample & .Text & vbCrLf
    Wend
    .Find.MatchWildcards = False 'Politely return to normal
    End With
    MsgBox strSample
    End Sub[/codebox]
    I've read that it's more efficient to work with ranges rather than with the selection object. Since it is easier to record and to debug using the Selection object, that's where I started. If performance becomes an issue (e.g., huge document), then you could optimize it further.[/quote]

  4. #4
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts
    [quote name='kweaver' post='792055' date='04-Sep-2009 02:16']Closing the FIND dialog box deselects those I found, unfortunately.[/quote]
    You should not be using the FIND dialog box, the example that Jefferson posted was using FIND from within VBA, and executing code each time it found matching data.

    The example simply appends the numbers to a text string and when if has finished it outputs the entire string in a message box. You will need to modify the code so that it copies the numbers to where you need them.

    Can you specify a bit more clearly what you mean by "extract those to, say, an Excel file?" Do you want a new Excel file created with all the numbers in a single column, or do they need to be at a specific place in an existing Excel file, or ...

  5. #5
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    The numbers of the format xx-xxxx could be in a new Excel file, in the A column beginning in the first row.

    Thanks.

    [quote name='StuartR' post='792074' date='04-Sep-2009 03:07']You should not be using the FIND dialog box, the example that Jefferson posted was using FIND from within VBA, and executing code each time it found matching data.

    The example simply appends the numbers to a text string and when if has finished it outputs the entire string in a message box. You will need to modify the code so that it copies the numbers to where you need them.

    Can you specify a bit more clearly what you mean by "extract those to, say, an Excel file?" Do you want a new Excel file created with all the numbers in a single column, or do they need to be at a specific place in an existing Excel file, or ...[/quote]

  6. #6
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts
    [quote name='kweaver' post='792110' date='04-Sep-2009 13:38']The numbers of the format xx-xxxx could be in a new Excel file, in the A column beginning in the first row.[/quote]
    Try this, it will prompt you for where to save the Excel workbook.
    [codebox]
    Public Sub NumbersToExcel()
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlWsh As Object
    Dim blnStartExcel As Boolean
    Dim i As Integer

    On Error Resume Next

    Set xlApp = GetObject(, "Excel.Application")
    If xlApp Is Nothing Then
    Set xlApp = CreateObject("Excel.Application")
    If xlApp Is Nothing Then
    MsgBox "Cannot activate Excel!", vbExclamation
    Exit Sub
    End If
    blnStartExcel = True
    End If

    On Error GoTo ErrHandler

    Set xlWbk = xlApp.Workbooks.Add
    Set xlWsh = xlWbk.Worksheets(1)

    With ActiveDocument.Content
    With .Find
    .ClearFormatting
    .Text = "[0-9]{2}-[0-9]{4}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True 'Essential!
    End With
    While .Find.Execute
    ' Found string is selected; do stuff here
    i = i + 1
    xlWsh.Cells(i, 1) = "'" & .Text
    Wend
    .Find.MatchWildcards = False 'Politely return to normal
    End With

    ExitHandler:
    On Error Resume Next
    xlWbk.Close SaveChanges:=True
    If blnStartExcel Then
    xlApp.Quit
    End If
    Set xlWsh = Nothing
    Set xlWbk = Nothing
    Set xlApp = Nothing
    Exit Sub

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler

    End Sub
    [/codebox]

  7. #7
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    Thank you, Stuart...perfect!!

    [quote name='StuartR' post='792131' date='04-Sep-2009 09:49']Try this, it will prompt you for where to save the Excel workbook.
    [codebox]
    Public Sub NumbersToExcel()
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlWsh As Object
    Dim blnStartExcel As Boolean
    Dim i As Integer

    On Error Resume Next

    Set xlApp = GetObject(, "Excel.Application")
    If xlApp Is Nothing Then
    Set xlApp = CreateObject("Excel.Application")
    If xlApp Is Nothing Then
    MsgBox "Cannot activate Excel!", vbExclamation
    Exit Sub
    End If
    blnStartExcel = True
    End If

    On Error GoTo ErrHandler

    Set xlWbk = xlApp.Workbooks.Add
    Set xlWsh = xlWbk.Worksheets(1)

    With ActiveDocument.Content
    With .Find
    .ClearFormatting
    .Text = "[0-9]{2}-[0-9]{4}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True 'Essential!
    End With
    While .Find.Execute
    ' Found string is selected; do stuff here
    i = i + 1
    xlWsh.Cells(i, 1) = "'" & .Text
    Wend
    .Find.MatchWildcards = False 'Politely return to normal
    End With

    ExitHandler:
    On Error Resume Next
    xlWbk.Close SaveChanges:=True
    If blnStartExcel Then
    xlApp.Quit
    End If
    Set xlWsh = Nothing
    Set xlWbk = Nothing
    Set xlApp = Nothing
    Exit Sub

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler

    End Sub
    [/codebox][/quote]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •