Option Explicit
Sub test()
Dim xmlHTTP As Object, javaText As String, HostName As String, str() As String, pos As Integer
Dim link As String, c As Object, fso As Object, TextStream As Object, objRegExp As Object, objSb As Object, WshShell As Object
Dim PathTemp As String, FileTemp As String
Set xmlHTTP = CreateObject("MSXML2.XMLHTTP")
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set objRegExp = CreateObject("VBScript.RegExp")
HostName = "http://www.gruzovozoff.ru"
PathTemp = "C:\Temp\"
FileTemp = Replace(fso.GetTempName, ".tmp", "")
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.MultiLine = True
objRegExp.Pattern = "<script[^>]*>([^<>]*(?=city = new Array)+[^<>]*)</script>"
xmlHTTP.Open "GET", HostName & "/rus/rates.php", False
xmlHTTP.Send
Do While xmlHTTP.readyState <>  4 
    DoEvents
Loop
Set objSb = objRegExp.Execute(xmlHTTP.ResponseText).Item( 0 ).Submatches
Set xmlHTTP = Nothing
javaText = Replace(objSb.Item( 0 ), Chr( 13 ), "")
javaText = Replace(javaText, Chr( 10 ), "")
javaText = javaText & " var fso = WScript.CreateObject('Scripting.FileSystemObject');"
javaText = javaText & " var TextStream = fso.CreateTextFile('" & Replace(PathTemp, "\", "\\") & FileTemp & ".txt',true);"
javaText = javaText & " var k; for(k in citiesCache){TextStream.WriteLine(citiesCache[k]['name']+' | '+citiesCache[k]['local']+' | '+citiesCache[k]['in']+' | '+citiesCache[k]['out']);}"
Set TextStream = fso.CreateTextFile(PathTemp & FileTemp & ".js")
TextStream.Write javaText
TextStream.Close
WshShell.Run "wscript.exe " & PathTemp & FileTemp & ".js",  1 , True
Set TextStream = fso.OpenTextFile(PathTemp & FileTemp & ".txt",  1 )
pos =  1 
While Not TextStream.AtEndOfStream
    Erase str
    str = Split(TextStream.ReadLine(), " | ")
    pos = pos +  1 
    Лист1.Cells(pos,  1 ).Value = str( 0 )
    Set c = Лист1.Cells(pos,  2 )
    link = HostName & Replace(str( 1 ), "..", "")
    c.Hyperlinks.Add Anchor:=c, Address:=link, ScreenTip:=link
    c.Value = "local"
    c.Font.Underline = xlUnderlineStyleNone
    Set c = Лист1.Cells(pos,  3 )
    link = HostName & Replace(str( 2 ), "..", "")
    c.Hyperlinks.Add Anchor:=c, Address:=link, ScreenTip:=link
    c.Value = "in"
    c.Font.Underline = xlUnderlineStyleNone
    Set c = Лист1.Cells(pos,  4 )
    link = HostName & Replace(str( 3 ), "..", "")
    c.Hyperlinks.Add Anchor:=c, Address:=link, ScreenTip:=link
    c.Value = "out"
    c.Font.Underline = xlUnderlineStyleNone
Wend
TextStream.Close
fso.DeleteFile PathTemp & FileTemp & ".js"
fso.DeleteFile PathTemp & FileTemp & ".txt"
Set TextStream = Nothing
Set fso = Nothing
End Sub