EXCLE VBAでファイルをダウンロード

Question

前提・実現したいこと

メールにファイルのダウンロード先アドレスが書いてあり、
それをダブルクリックするとwebブラウザが立ち上がって
ファイル(zioファイル)がダウンロードできるというシステムがあります。

そのアドレスはメールにたくさん書かれていて、
http://www.hogegege.jp/index.php?type=download&no=101
http://www.hogegege.jp/index.php?type=download&no=105
http://www.hogegege.jp/index.php?type=download&no=116
http://www.hogegege.jp/index.php?type=download&no=119
http://www.hogegege.jp/index.php?type=download&no=206
というよう感じで数十個も羅列されています。
一個ずつクリックするのが面倒なので、エクセルのA列にこのアドレスを張り付けて、
あとは自動でダウンロードさせたいです。
そして、成功したらB列に「DL成功」、失敗したら「DL失敗」と記入したいです。

下記のような感じのコードをイメージしていますが、
ダウンロードする関数(s) をどう記述すればよいかアドバイスをお願いします。

For each s in Ramge("A:A")
 str= s.value
 ret=ダウンロードする関数(str) 'ダウンロード実行
 s.offset(0,1)=ret 'ダウンロード結果をB列に記録
Next

URLDownloadToFileという関数は見つけたのですが、私の場合は
http://www.hogegege.jp/index.php?type=download&no=xx
というphpコードを送信するので、URLDownloadToFileではそもそも送信できないことまでわかっています。コードを書く以前に使えないことが自明なのでコードの書きようがなく、自力で書けたのがFor・・・Nextのところだけでした。
phpコードを送って戻り値も得るという方法は、どうしても見つかりません。
そのようなわけでアドバイスをお願いした次第です。

Comments

[occhy]

できるだけ自分でがんばって考えて、コードまで書いてみました。
丸投げという意図はまったくありません。
丸投げだったら、アドバイスを求めるのでなく、コードを教えてほしいと書いたと思います。
そこのところ誤解があったようで申し訳ありません。

[YT0014]

検索などで、"ダウンロードする関数"の情報を集められたのでしょうか？
質問内容やコードを見る限り、行った形跡が見えませんので、他者からすれば、丸投げに見えます。「できるだけがんばる」に、"できる限りの情報を収集して試してみる"という行為を追加するようにしてください。
ダウンロードする関数 VBA での検索を試み、結果ページを確認した上で、解決できたなら自己解決を、解決できなかったら、問題点を整理し直し、質問文を編集して、修正してください。

[occhy]

そういうことだったのですね。申し訳ありません。
問題点を整理し直し、質問文を編集して、修正しました。

Answer 1

URLDownloadToFileという関数は見つけたのですが、私の場合は

http://www.hogegege.jp/index.php?type=download&no=xx
というphpコードを送信するので、URLDownloadToFileではそもそも送信できないことまでわかっています。

ご提示いただいている対象リンク文字列は、ＵＲＬであり、phpコードではありません。

当然、URLDownloadToFileにて、ダウンロード可能です。

Comments

[occhy]

思い込みがあったようですみません。
以下のコードでダウンロードまではできました。

Sub test()
Dim ret, str
For Each s In Sheets(1).Range("A1:A10")
str = s.Value
ret = URLDownloadToFile(0, str, "aaa.zip", 0, 0) 'ダウンロード実行
s.Offset(0, 1) = ret 'ダウンロード結果をB列に記録
Next

あと残課題は、保存するファイル名の引数の"aaa.zip"のところを、サーバ側のファイル名にするというところですが、ファイル名はダウンロードしないとわからないので、指定できないのですが、これがまだ解決していません。
引数をnullにしたらエラーになったので、どうしたものかという状態です。

Answer 2

手軽にやるなら、こんな感じでやればダウンロードはできそう。
成否の判断までやろうとするともう少しちゃんと考えないと。

For each s in Ramge("A:A")
 s.Hyperlinks(1).Follow 'ダウンロード実行
Next

Comments

[occhy]

この方法でダウンロードはできました。
これだけでもすごく助かりますが、なかにはリンク先が存在しない場合があり、そこはエラーにしたいです。
リンク先が存在しないのが問題だと思うのですが、ちょっと別問題なので、成否判断で決着をつけたいです。

Answer 3

phpのリンクから実際のダウンロード先を取得し、ファイル名を抽出して保存します。

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
   (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
    ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

'----------------------------------
'リンクから本当のダウンロード先を得る関数。
'たとえば
'GetLocation("http://www.hogegege.jp/index.php?type=download&no=101")
'とすればrealUrlに本当のダウンロード先（ファイル名含む）が入る
Function GetLocation(url As String) As String
    Dim httpObj As Object
    
    Set httpObj = CreateObject("MSXML2.ServerXMLHTTP")
    httpObj.Open "HEAD", url, False
    httpObj.send
    GetLocation = httpObj.getOption(-1)  'SXH_OPTION_URL
End Function

'----------------------------------
' ダウンロード
' url     ダウンロード先リンク（phpのリンクでも可）
' savedir ファイルの保存先フォルダ
Sub DownloadFile(url As String, savedir As String)
    Dim res, idx As Long
    Dim realUrl, fname As String
    Dim strPath As String

    '指定した保存先ディレクトリの末尾にパス区切りが付いているかチェック
    If Right(savedir, 1) <> "\" Then
        savedir = savedir & "\"
    End If
    
    'urlからファイル名を抜き出す
    realUrl = GetLocation(url)
    idx = InStrRev(realUrl, "/")
    fname = Mid(realUrl, idx + 1)
    
    '保存するファイルパス・ファイル名を作成
    strPath = savedir & fname

    res = URLDownloadToFile(0, url, strPath, 0, 0)
    If res = 0 Then
        Debug.Print "ダウンロード完了: " & url
    Else
        Debug.Print "エラー： " & url
    End If
End Sub

'----------------------------------
' テスト
Sub Test()
    Dim ret, str, savedir
    savedir = "C:\TEST\"   '保存フォルダ
    
    For Each s In Sheets(1).Range("A1:A10")
        url = s.Value
        ret = DownloadFile(url, savedir) 'ダウンロード実行
        s.Offset(0, 1) = ret 'ダウンロード結果をB列に記録
    Next
End Sub

検証環境：
Windows 10 Pro 20H2
Excel 2019

Comments

[occhy]

MSXML2.ServerXMLHTTPにはまったくたどり着けていませんでした。
こういう手段があるのですね。
早速試してみたのですが、
DownloadFile(url , savedir)を実行したら、戻り値が引数のurlと同じになってしまいました。
どうやらサーバのほうではリアルなファイルアドレスはないみたいで、phpでなにか処理して動的にファイルを生成してからダウンロードに供しているようです。
IＥを利用する方法しかなさそうな気がしてきましたが、VBAだけでなんとかなりそうなものでしょうか。

[退会済みユーザー]

Debug.print GetLocation(ダウンロード先url)
を実行した場合でも、実際のファイルのアドレスは表示されないでしょうか？

また、そのダウンロード先urlは実際にファイルがダウンロードできる（ファイルが存在する）urlでしょうか？

(ファイルが存在しないurlをGetLocation関数に引数に指定すると、その戻り値は、引数に指定したurlと同じになるので）

[occhy]

Debug.print GetLocation(ダウンロード先url)
を実行したところ、ダウンロード先urlが戻り値として帰ってきました。
ダウンロード先にファイルがあるかどうかはよくわかりません。外からはサーバの中身がどうなっているかわからないようになっています。たぶんリクエストを受けたときに何か処理して(動的ななにかをしている)ファイルを送信しているのだと推測しています。そういうことでは、ただ単純にダウンロードできるファイルが存在するというわけではないみたいです。
DownloadFileが保存先引数がNULLの場合はサーバ側のファイル名で保存、という仕様の関数だったら話は簡単だったのですが、どうもそう簡単な話ではないようでして。
もうVBAでやるのはあきらめようかな、と思い始めてきました。

[退会済みユーザー]

「ダウンロード先にファイルがあるかどうかはよくわかりません。」とのことですが、そのリンク（例：http://www.hogegege.jp/index.php?type=download&no=101）を、ChromeやInternet Explorer等のブラウザ欄に貼り付けてエンターキーを押したら、何らかのファイルをダウンロードすること自体はできる、ということでしょうか。
（もし。この方法でダウンロードできるにもかかわらず、同じURLに関して上記VBAコードでDLできないなら、VBAでは無理そうですね）

[occhy]

はい、そのとおりです。
あきらめることにします。