#1
|
|||
|
|||
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 Last edited by macropod; 11-10-2017 at 12:57 PM. Reason: Added code tags |
#2
|
||||
|
||||
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 [Fmr MS MVP - Word] |
|
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 |
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 email address from field | zssteen | Excel | 1 | 06-19-2009 02:32 AM |