This type of data recovery is highly document dependent but based on your sample, the following will recover the data and write it to your output document. If the document layout changes then it won't work.
Code:
Option Explicit
Sub Macro1()
Const strPath As String = "C:\Path\output data 0825.doc" 'The path where the data collection document is stored
Dim oRng As Range, oRng2 As Range
Dim oColl As Collection
Dim lngCol As Long
Dim strName As String
Dim strAddress As String
Dim strPostCode As String
Dim strPhone As String
Dim strEmail As String
Dim oTarget As Document
Dim vAdd As Variant
Dim oSource As Document
Set oSource = ActiveDocument
Const sNum As String = "0123456789"
Set oRng = oSource.Range
Set oColl = New Collection
With oRng.Find
Do While .Execute(FindText:="<a href=""/name/")
On Error GoTo lbl_Exit
If InStr(oRng, "<a href=""/name/") > 0 Then
With oRng
.Collapse 0
.MoveEndUntil Chr(34)
strName = Replace(.Text, "-", " ")
.Collapse 0
.End = oSource.Range.End
.End = .Start + InStr(oRng, "<span itemprop=""streetAddress"">")
.MoveEndUntil sNum
.Collapse 0
.MoveEndUntil "<"
strAddress = .Text
.End = .Paragraphs(1).Range.End - 1
.MoveEndUntil sNum, wdBackward
.Collapse 0
.MoveStartUntil ">", wdBackward
strPostCode = .Text
.End = oSource.Range.End
.End = .Start + InStr(oRng, "<span itemprop=""telephone"">") + 26
.Collapse 0
.MoveEndWhile sNum & "-"
strPhone = .Text
.End = oSource.Range.End
.End = .Start + InStr(oRng, "<span itemprop=""email"">") + 22
.Collapse 0
.MoveEndUntil "<"
strEmail = .Text
oColl.Add strAddress & "|" & strPostCode & "|" & strName & "|" & strPhone & "|" & strEmail
.Collapse 0
End With
End If
Loop
End With
If oColl.Count > 0 Then
Set oTarget = Documents.Open(strPath)
Set oRng2 = oTarget.Range
For lngCol = 1 To oColl.Count
vAdd = Split(oColl(lngCol), "|")
oRng2.Collapse 0
oRng2.Text = vbCr & vAdd(0) & " , " & vAdd(1) & vbTab & vAdd(2) & vbTab & vAdd(3) & vbTab & vAdd(4)
Next lngCol
End If
lbl_Exit:
Set oSource = Nothing: Set oTarget = Nothing
Set oRng = Nothing: Set oRng2 = Nothing
Set oColl = Nothing
Exit Sub
End Sub