URL ダウンロード

strUrl="http://..."

LocalPath="C:\TEMP"

on error resume next

Dim objweb

Dim arwork

Dim objADO

Dim ret,res

arwork = split(strURL,"/")

strFname = LocalPath & "\" & 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

er= "接続ステータス : " & objweb.Status & " (" & objweb.statusText & ")" & _

vbCrLf & strFname & " に保存しました"

Set objADO = Nothing

Set objweb = Nothing

else ' err

er= "CreateObject失敗."

end if