Const adTypeBinary = 1
Const adTypeText   = 2
Const adSaveCreateNotExists = 1
Const adSaveCreateOverWrite = 2

Dim objHTTP, objStream

Target = "東京都港区東新橋一丁目6-1"

Target = UrlEncode(Target)

url = "http://maps.google.com/maps/geo?q=" _
    & Target _
    & "&" _
    & "key=キーは自分で取得したものを記述します" _
    & "&" _
    & "output=xml"

txt = "x:\geo.var"

Set objHTTP   = WScript.CreateObject("MSXML2.XMLHTTP")
Set objStream = WScript.CreateObject("ADODB.Stream")
objStream.Open

Call objHTTP.Open("GET", url, FALSE)
objHTTP.Send (Null)

If objHTTP.Status = 200 Then
    objStream.Type = adTypeBinary
    objStream.Write objHTTP.ResponseBody
Else
    Error = "Error Status : " & objHTTP.Status & _
            vbCrLf & _
            "Error StatusText : " & objHTTP.StatusText & _
            vbCrLf & vbCrLf & _
            "ResponseHeaders : " & objHTTP.getAllResponseHeaders()
    objStream.Type = adTypeText
    objStream.writeText Error
End If

objStream.SaveToFile txt, adSaveCreateOverwrite
objStream.Close

Set Src = CreateObject("ADODB.Stream")
Src.Open
Src.Type = adTypeText
'Src.Charset = "_autodetect_all"
Src.Charset = "UTF-8"
Src.LoadFromFile txt

Set Dst = CreateObject("ADODB.Stream")
Dst.Open
Dst.Type = adTypeText
Dst.Charset = "Shift_JIS"
Src.CopyTo Dst
Src.Close

Dst.SaveToFile txt, adSaveCreateOverWrite
Dst.Close

Dim fs

Set fs = WScript.CreateObject("Scripting.FileSystemObject")
Set i = fs.OpenTextFile(txt)
strAll = i.ReadAll
i.Close

strAll = Replace (strAll,vbCrLf,"")
strAll = Replace (strAll,vbLf,"")
strAll = Replace (strAll,vbCr,"")
strAll = Replace (strAll,vbTab,"")

Dim RegExp

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "<kml.*?>.*?</kml>"

Set Matches1 = RegExp.Execute(strAll)
For Each Match1 in Matches1

    str = "geo,文字列,共通,"

    RegExp.Pattern = "<name>.*?</name>"
    Set Matches2 = RegExp.Execute(Match1.Value)
    For Each Match2 in Matches2
      RegExp.Pattern = "<.*?>|&nbsp;?"
      str =str & """" & RegExp.Replace(Match2.Value,"") & """" & ","
    Next

    RegExp.Pattern = "<code>.*?</code>"
    Set Matches2 = RegExp.Execute(Match1.Value)
    For Each Match2 in Matches2
      RegExp.Pattern = "<.*?>|&nbsp;?"
      str = str & RegExp.Replace(Match2.Value,"") & ","
    Next

    RegExp.Pattern = "<coordinates>.*?</coordinates>"
    Set Matches2 = RegExp.Execute(Match1.Value)
    For Each Match2 in Matches2
      RegExp.Pattern = "<.*?>|&nbsp;?"
      str = str & RegExp.Replace(Match2.Value,"") & vbCrLf
    Next

Next

Set o = fs.OpenTextFile(txt, 2, True)
o.Write str
o.Close

Private Function UrlEncode(strSource)
    Dim sc
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"
    Dim js
    Set js = sc.CodeObject
    UrlEncode = js.encodeURI(strSource)
End Function