Set fso = CreateObject("Scripting.FileSystemObject")
For Each f in fso.GetFolder(".").Files
    ext = LCase(fso.GetExtensionName(f))
    If ext = "htm" or ext = "html" or ext = "mht" Then
        txt = fso.OpenTextFile(f).ReadAll
        fso.OpenTextFile(f & ".txt", 2, true).Write GetUrl(txt)
    End If
Next
MsgBox "OK"

Function GetUrl(str)
    Set re = New RegExp
    re.Pattern = "http://[\w\.\-/]+\.(com|cn|html)"
    re.Global = True
    re.IgnoreCase = True
    For Each m in re.Execute(str)
        If InStr(s, m & vbCrLf) = 0 Then s = s & m & vbCrLf
    Next
    GetUrl = s
End Function
复制代码