vbsで指定したフォルダへの保存。

下記のようになります。

Const adTypeBinary = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

For i= 0 To 6 '現在時刻から6時間後まで
    dYear = Fmt(Year(Now),4)
    dMonth = Fmt(Month(Now),2)
    dDay = Fmt(Day(Now),2)
    dHour = Fmt(Hour(Now),2)
    dMinute = "00"
    dName = dYear & dMonth & dDay & dHour & dMinute & "-0" & i & ".png"
    sSource = "http://www.jma.go.jp/jp/radame/imgs/prec/000/" & dName 'ダウンロード元
    Set ws = WScript.CreateObject("WScript.Shell") '特殊フォルダ名の取得
    desktopDir = ws.SpecialFolders("Desktop") 'デスクトップの実体
    sDest = desktopDir & "\保存フォルダ\" & dName 'コピー先
    Set oHTTP = WScript.CreateObject("Msxml2.XMLHTTP")
    oHTTP.Open "GET", sSource, False
    oHTTP.Send
    Set Stream = WScript.CreateObject("Adodb.Stream")
    Stream.Type = adTypeBinary
    Stream.Open
    Stream.Write oHTTP.responseBody
    Stream.Savetofile sDest, adSaveCreateOverWrite
Next

Function Fmt(num, digit) '0を頭につけて桁数を合わせる（例：6→06）
    Fmt = Right(String(digit, "0") & num, digit)
End Function