Microsoft Office Forums Extract name and address.

Go Back   Microsoft Office Forums > >

Closed Thread
 
Thread Tools Display Modes
  #1  
Old 11-10-2017, 12:16 PM
donlincolnmsof donlincolnmsof is offline Extract name and address. Windows 7 64bit Extract name and address. Office 2003
Novice
Extract name and address.
 
Join Date: Oct 2011
Posts: 26
donlincolnmsof is on a distinguished road
Default Extract name and address.

Hello

The following macro was written by a member of this board a while back and while most of the structure of the macro would be same but the data extracted gets changed.

Name, address and phone numbers

I was wondering if any one can help me with this macro I will really appreciate it.

Attached are the word files for

1) Sample data to extract
2) output data.


Data block where text in the sample data file that has the following format.


-----------------------------------------------------------------------------------
Code:
John C Sechser                            </a>
                        </h3>

                                                    <div class="c-people-result__address">5288 Cedar RD, Saint Augustine, FL 32080</div>
                                                                            <div class="c-people-result__phone">(407) 489-4431</div>

Macro that was written.
--------------------------

Code:
Option Explicit

Sub Macro1()
'Graham Mayor - http://www.gmayor.com - Last updated - 23 Jul 2017
Dim oDoc As Document
Dim oNewDoc As Document
Dim oRng As Range, oRng2 As Range, oFound As Range
Dim vFind As Variant
Dim fso As Object
Dim strPath As String
Const strFind As String = "Add to watchlist|TOTAL REVENUE"

strPath = Environ("USERPROFILE") & "\Desktop\DataExtract.doc"     'The name of the document to save the extract
    Set fso = CreateObject("Scripting.FileSystemObject")
    vFind = Split(strFind, "|")
    Set oDoc = ActiveDocument
    If fso.FileExists(strPath) Then
        Set oNewDoc = Documents.Open(FileName:=strPath, AddToRecentFiles:=False)
    Else
        Set oNewDoc = Documents.Add
        oNewDoc.SaveAs FileName:=strPath
    End If
    Set oRng = oDoc.Range
    With oRng.Find
        Do While .Execute(FindText:=vFind(0))
            oRng.MoveStart wdParagraph, -2
            oNewDoc.Range.InsertAfter _
                    Left(oRng.Paragraphs(1).Range.Text, _
                         Len(oRng.Paragraphs(1).Range.Text) - 1)
            Set oFound = oRng
            oFound.End = oDoc.Range.End
            With oFound.Find
                Do While .Execute(FindText:=vFind(1))
                    oFound.End = oFound.Paragraphs(1).Range.End - 1
                    Set oRng2 = oNewDoc.Range
                    oRng2.End = oRng2.End - 1
                    oRng2.Collapse 0
                    oRng2.Text = vbTab & oFound.Text & vbCr
                    oRng.Collapse 0
                    Exit Do
                Loop
            End With
            oRng.Collapse 0
        Loop
    End With
    With oNewDoc.Range
        .ParagraphFormat.TabStops.ClearAll
        .ParagraphFormat.TabStops.Add CentimetersToPoints(6.5)
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Arial"
        .Font.Size = 8
    End With

    'oNewDoc.Close wdSaveChanges 'Optional
lbl_Exit:
    Set fso = Nothing
    Set oDoc = Nothing
    Set oNewDoc = Nothing
    Set oRng = Nothing
    Set oRng2 = Nothing
    Set oFound = Nothing
    Exit Sub
End Sub
Attached Files
File Type: doc macro with data.doc (105.0 KB, 2 views)
File Type: doc output file.doc (21.0 KB, 3 views)

Last edited by macropod; 11-10-2017 at 12:57 PM. Reason: Added code tags
  #2  
Old 11-10-2017, 12:59 PM
macropod's Avatar
macropod macropod is offline Extract name and address. Windows 7 64bit Extract name and address. Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,596
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

This is a duplicate of your post here: https://www.msofficeforums.com/word-...ges-macro.html
Kindly don't ask the same question in multiple threads.

Thread closed.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Closed Thread

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Add link to email address that hides the actual address or makes it inaccessible to online bots richiebabes Word 1 09-03-2014 03:22 PM
Extract name and address. How to forward all e-mails from one address to five (5) other e-mail address? adi2012 Outlook 1 09-09-2012 06:41 PM
HELP! Outlook 2003 Address Books - multiple account address lists ukmonkeynuts Outlook 0 06-01-2011 06:18 AM
Default Home Address over Business Address DunnDeal Outlook 1 12-03-2010 04:56 PM
Extract name and address. Extract email address from field zssteen Excel 1 06-19-2009 02:32 AM


All times are GMT -7. The time now is 11:15 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2019 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft