VBScriptでWebからファイルダウンロード

VBScriptでファイルのダウンロードサンプル。
getHTTPasync() にURLを指定すれば可能。
MSXML2.ServerXMLHTTP.6.0 を使っているが、失敗したらMSXML2.ServerXMLHTTP やMSXML2.XMLHTTPに切り替えて再度試みている。


'=====================================================================
'スクリプトと同じディレクトリ上にファイルを保存します。
' USING MSXML2.ServerXMLHTTP
'  if you need proxy for web browsing,use Proxycfg.exe
' see also:
'  http://support.microsoft.com/kb/290761
'  http://support.microsoft.com/kb/309436
'=====================================================================
call getHTTPasync("http://siosalt.tokyo/images/DSC_0188.JPG")
Sub getHTTPasync(strURL)
on error resume next
Dim objweb
Dim arwork
Dim objADO
Dim ret,res
arwork = split(strURL,"/")
strFname = Replace(Wscript.ScriptFullName,Wscript.ScriptName,"") & arwork(Ubound(arwork))
err.clear
Set objweb = CreateObject("MSXML2.ServerXMLHTTP.6.0")
'MSXML環境依存なるべく排除
if err.number <> 0 then
err.clear
Set objweb = CreateObject("MSXML2.ServerXMLHTTP")
end if
if err.number <> 0 then
err.clear
Set objweb = CreateObject("MSXML2.XMLHTTP")
end if
if err.number = 0 then
'objweb.Open "GET",strURL,False,"ユーザーID", "パスワード"
objweb.Open "GET", strURL, False
objweb.Send
res = objweb.responseBody
set objADO = CreateObject("ADODB.Stream")
objADO.Type = 1 'BINARY
objADO.Open()
objADO.Write(res)
objADO.SaveToFile strFname,2 ' SAVE CREATE OVERWRITE
objADO.Close
wscript.echo "接続ステータス : " & objweb.Status & " (" & objweb.statusText & ")" & _
vbCrLf & strFname & " に保存しました"
Set objADO = Nothing
Set objweb = Nothing
else ' err
wscript.echo "CreateObject失敗."
end if
End Sub

  1. しっ on

    KS様
    えー、call getHTTPasync()行から、End Sub行までをメモ帳にコピーして、ファイル名test.vbs で保存します。
    で、test.vbs をダブルクリックすれば実行されます。
    自宅での検証結果の備忘録ですので、色々はしょって書いてます。ご了承くださいませ。

  2. ExcelのVBAでJSON形式のデータを解析する

    WebサーバーからJSON形式のデータを取得し、セルに表示してみようと思います。
    ・・・というのも、Webアプリのマスタ系のデータ保守を行うにあ…

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

CAPTCHA