|
URLDownloadToFile APIを使用して、 |
やっと、下記、メルマガで発行した内容です。何かの参考となれば幸いです。
過去のメルマガ[IE操作系の記事一覧]もヨロシクです。
＜URLDownloadToFile APIを使用してダウンロードしてみた＞
今回は、 Web上のpdfファイルをダウンロードしてみたいと質問をもらったので、 チャレンジしてみます。 サンプルファイルは、 http://www.ken3.org/vba/lzh/vba120.lzh にvba120.xlsが保存されています。 その他サンプル: [Document.Images の 一覧から 画像ファイルをダウンロード] ← Webページ内の画像をDocument.Imagesから取り出し、URLDownloadToFileでダウンロードしたサンプル。 [VBA IE操作 リンクの取り出し と ダウンロード IE6+Excel2003] ←ダウンロードとの組み合わせとサンプルファイルです。 サンプルにキレがないけど こちらも合わせてみてください/* * １. 今回のキッカケ */
掲示板に下記の質問をもらいました。 ----- >以前のものでExcelからIeを立ち上げて、ユーザー名、パスワードを >入力して開くということが書かれていました。また、リンク先を拾うと >言う処理も書かれていました。さて、ここからなんですが、リンク先に >設定されているPDFファイルを特定のフォルダへ保存するという処理は >どうやったらいいのでしょうか？ ----- リンク先を保存かぁ、あるよね、そんな処理。/* * ２．保存方法を探る */
Webで保存方法を探るが、なかなか、ヒットしない。 みなさん、ダイアログにSendKeysしたりとイロイロ苦労しているみたいです。 しかたないので、マイクロソフトのページをみてみる。 使えそうな？ URLDownloadToFile？ってヤツが載ってました。 日本語のサポートかと思ったら、ヘッダ部分だけ日本語？ こんなのアリなの？ なんて、文句は置いといて、下記のURLに情報載ってます。 http://support.microsoft.com/support/kb/articles/q244/7/57.asp The WebBrowser control and Internet Explorer have Save and Save As options that can be used to save files using the ExecWB command. However, this involves prompting from the user. There is no way to suppress this prompt. To save files to the hard-disk without prompting, use the URLDownloadToFile API from URLMON. MORE INFORMATION The declaration for URLDownloadToFile is as follows: Private Declare 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 The function can be called as follows: returnValue = URLDownloadToFile(0, "http://www.microsoft.com/ms.htm" _ "c:\ms.htm", 0, 0) Note that when downloading HTML files, embedded content like images and objects will not be downloaded./* * ３．単体でテストを行う */
URLDownloadToFile って API が URLMON ってところにあるらしい。 APIの宣言文はそのままコピーして、下記のように使ってみた。 'URLDownloadToFile API from URLMON. Private Declare 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
Sub aaa()
Const strURL = "http://www.ken3.org/index.html"
Dim strFNAME As String 'ダウンロード先（パス＋ファイル名）
Dim returnValue
'ファイル名をブックのパス＋test.htmlとする
strFNAME = ThisWorkbook.Path & "\test.html"
'URLDownloadToFile API をコールする
returnValue = URLDownloadToFile(0, strURL, strFNAME, 0, 0)
'結果の表示
MsgBox "結果は：" & returnValue
MsgBox strFNAME & "に保存されました"
End Sub |
Sub bbb()
'IODATAのカタログをダウンロードしてみた
Const strURL = "http://www.iodata.co.jp/products/pdf/20030809/memory_n-s-p.pdf"
Dim strFNAME As String 'ダウンロード先（パス＋ファイル名）
Dim returnValue
'ファイル名をブックのパス＋test.pdfとする
strFNAME = ThisWorkbook.Path & "\test.pdf"
'URLDownloadToFile API をコールする
returnValue = URLDownloadToFile(0, strURL, strFNAME, 0, 0)
'結果の表示
MsgBox "結果は：" & returnValue
MsgBox strFNAME & "に保存されました"
End Sub |
Sub test_main()
Dim objIE As Object
Dim time10 As Date
Dim strURL As String
Dim i As Integer
Dim nYLINE As Integer
On Error GoTo EMSG
'IEの起動
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする
objIE.GoHome '初期ページの表示
Do While objIE.Busy = True '起動まで待つ
DoEvents
Loop
'Excelをアクティブにする。
AppActivate "Microsoft Excel"
'初期処理
Rows("13:1000").Select '結果の表示エリアをクリアする
Selection.Delete Shift:=xlUp
nYLINE = 13 '13行目からデータをセットするので
'読み込むページのURLを代入
strURL = "http://www.ken3.org/backno/backno_vba15.html"
objIE.Navigate "" & strURL 'アドレスを渡し表示する
'読みこみ完了まで待つ
'30秒後を計算して、待つ
time10 = DateAdd("s", 30, Now())
Do While objIE.Busy = True
DoEvents
If time10 < Now() Then
Exit Do
End If
DoEvents
Loop
If objIE.Busy = True Then
Cells(nYLINE, "A") = "タイムアウトです、読み込みに失敗しました"
MsgBox "タイムアウトです、読み込みに失敗しました"
Exit Sub '関数を抜ける
End If
'リンクを探す
'リンク数分まわす
For i = 0 To objIE.Document.links.Length - 1
Cells(nYLINE, "A").Select '遊びでカーソル移動
DoEvents
Cells(nYLINE, "A") = "'" & objIE.Document.links(i).outerText
Cells(nYLINE, "B") = "'" & objIE.Document.links(i).href
'後ろが.htmlならファイルダウンロードの関数を呼ぶ
If Right(objIE.Document.links(i).href, 4) = "html" Then
Cells(nYLINE, "C") = Now '遊びで開始時刻をセット
'ダウンロード関数を呼ぶ
Call get_url_file(objIE.Document.links(i).href)
Cells(nYLINE, "D") = Now
End If
'次のセット位置にする
nYLINE = nYLINE + 1 'セット位置を＋1する
Next i
objIE.Quit 'ＩＥを閉じる
MsgBox "終了しました"
Exit Sub
EMSG:
Cells(nYLINE, 2) = "ERR"
objIE.Quit '
MsgBox "errが発生しました"
Exit Sub
End Sub |
Sub get_url_file(strURL As String)
Dim strFNAME As String 'ダウンロード先（パス＋ファイル名）
Dim strWORK As String '後ろから/を探し、ファイル名を取り出す
Dim returnValue
Dim n As Integer
'ファイル名を取り出す
For n = Len(strURL) To 1 Step -1 '後ろから/を探す
If Mid(strURL, n, 1) = "/" Then
Exit For '/が見つかったらループを抜ける
End If
Next n
strWORK = Mid(strURL, n + 1) '/の次からファイル名なのでn+1から
'ファイル名をブックのパス＋\＋取り出したファイル名とする
strFNAME = ThisWorkbook.Path & "\" & strWORK
'strFNAME = "C:\DATA\AAA\" & strWORK と固定のパスでもＯＫだけど
'URLDownloadToFile API をコールする
returnValue = URLDownloadToFile(0, strURL, strFNAME, 0, 0)
End Sub |
三流解説を読んでいただき、どうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。
|
[三流君 VBAでWebBrowser IEを操作する] / [三流君 VBAで楽しくプログラミング] / [AB型の変わり者 三流プログラマー Ken3 三流君Top]
大分類:[Document.Forms(入力処理)]
/ [Document.Links(リンク情報)]
/ [Document.Images(画像情報)]
/ [Document.Frames(フレーム処理)] | |
|
F1でヘルプを見たり、デバック時にDebug.Print使ったり、イミディエイト ウインドウで簡単な確認したり。 項目別に↓にプログラマーの本音？それとも建て前？的な記事をまとめました。お探しのジャンルを選択してください。 項目別に↓に人気の記事をまとめてみました。お探しのジャンルを選択してください。 Excel関係: Access関係: その他：VBAの共通関数やテキストファイルの操作など Blog:[三流君の作業日記]/
[objIEを使用したサンプルコードを見る]/
広告-[通販人気商品の足跡] |
三流プログラマーのKen3 が 皆さんの質問にお答えします
と カッコつけて言っても、実力不足ですべての質問に回答することはできないのが現実なのですが、できる範囲で 三流的な逃げ手 や 解決方法 を探します(回答します)。
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。