The following code will extract the first address from all of the documents
in a folder (if each document is formatted as you indicated and it will
insert them into a new file.  You will have to come up with your own code
for the Visio part of it.

Dim MyPath As String
Dim MyName As String
Dim source As Document, target As Document
Dim addr As Range
Dim i As Long
'Create a new document to contain the addresses
Set target = Documents.Add
'let user select a path
With Dialogs(wdDialogCopyFile)
   If .Display() <> -1 Then Exit Sub
   MyPath = .Directory
End With
'strip quotation marks from path
If Len(MyPath) = 0 Then Exit Sub
If Asc(MyPath) = 34 Then
   MyPath = Mid$(MyPath, 2, Len(MyPath) - 2)
End If
'get files from the selected path
'and extract the first address
'and insert it into the target document
MyName = Dir$(MyPath & "*.*")
Do While MyName <> ""
   Set source = Documents.Open(MyName)
   i = 1
   With source
       Set addr = .Paragraphs(4).Range
       While Len(.Paragraphs(4 + i).Range) > 1
           addr.End = .Paragraphs(4 + i).Range.End
           i = i + 1
       Wend
   End With
   target.Range.InsertAfter addr & vbCr
   source.Close wdDoNotSaveChanges
Loop

On Jun 18, 10:52 am, Russ <drsN0SPAMmi...@hotmailD0Tcom.INVALID>
wrote:

yes, that's exactly how it looks.