電話番号を抜き出す

電話番号が１０〜１３桁になることから判別する部分をいれました。
（ＰＨＳが１１桁で−をいれると１３桁）
ただし、
東京都墨田区12-3456-7890
なんていう長い丁番地があると判別不能。ほとんど無いと思うけど。

Option Explicit

Sub Macro()
    ' データファイルのパスを指定
    Const FILENAME = "C:\Documents and Settings\hogehoge\デスクトップ\hatena\test.txt"
    Dim FSO
    Dim TS
    Dim str As String
    Dim i As Long
    Dim f As Boolean
    Dim Meisyou As String
    Dim RE
    Dim reMatch
    
    Set RE = CreateObject("VBScript.RegExp")
    RE.Pattern = "\d{1,4}?-\d{1,4}?-\d{1,4}"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TS = FSO.OpenTextFile(FILENAME, 1)
    i = 1
    Do Until TS.AtEndOfStream
        str = TS.ReadLine
        If f Then
            If IsNumeric(str) Then
                Cells(i, 1).Value = Meisyou
                
                Meisyou = ""
                i = i + 1
            Else
                If str <> "" Then
                    If Meisyou = "" Then
                        Meisyou = Trim(str)
                    Else
                        Set reMatch = RE.Execute(str)
                        If reMatch.Count > 0 Then
                            If Len(reMatch(0)) >= 10 And Len(reMatch(0)) <= 13 Then
                                Cells(i, 1).Value = Meisyou
                                Cells(i, 2).Value = reMatch(0)
                                
                                Meisyou = ""
                                f = False
                                i = i + 1
                            End If
                        End If
                    End If
                End If
            End If
        Else
            If IsNumeric(str) Then
                f = True
            End If
        End If
    Loop
    
    TS.Close
    Set TS = Nothing
    Set FSO = Nothing
    Set RE = Nothing
    MsgBox "終了"
End Sub