excelで仮想通貨のレート取得をexcel VBAでやっていますが、
windows10 office2016(64bit)ではレートを取得できますが、
windowsXP excel2007(32bit)ではエラーが出てしまいます(こちらでやりたい)
エラー内容
・ With CreateObject("WinHttp.WinHttpRequest.5.1")
実行時エラー’-2146893018(80090326)'
予期されない、または形式が間違ったメッセージを受信しました。
・ With CreateObject("MSXML2.XMLHTTP")
実行時エラー’-2146697208(800c0008)’
The download of the specified resource has failed.
上記2種類で試してみました。
ネットで調べてみましたが、サーバーの証明エラーでソフトを更新しても駄目でした。
http://xl.hisholy.net/excelvba/bitcoin-1/ 様を参考に作成しました。
**************************************************
Application.ScreenUpdating = False '画面描画を無効
Dim url As String 'レートを取得するためのURL
Dim res As String '取得するレスポンステキスト
Dim tbl As ListObject 'レートを記載するテーブルオブジェクト
Dim Rmax As Long 'テーブルの行数
Dim R As Long 'テーブルを繰り返すループ用変数
'シートに作成済みのテーブルをオブジェクト変数にセット
Set tbl = ThisWorkbook.Worksheets("bitbank").ListObjects("bitbank")
Rmax = tbl.ListRows.Count 'テーブルの最終行数を取得
For R = 1 To Rmax 'テーブルの1行目から最終行までループ
'単位に記載された仮想通貨のレートを取得するAPIのURLを設定
'仮想通貨単位を小文字に変換して _jpy を結合 例)BTC -> btc_jpy
url = "https://public.bitbank.cc/" _
& LCase(tbl.ListColumns("単位").DataBodyRange(R)) _
& "_jpy/ticker"
With CreateObject("WinHttp.WinHttpRequest.5.1") 'XMLHTTPオブジェクトを生成
.Open "GET", url, False '非同期モードで通信を開始
.send 'リクエストを送信
If .Status <> 200 Then Exit Sub 'リクエスト失敗で終了
res = "[" & .responsetext & "]" 'JSON文字列のレスポンス
'Javascriptオブジェクトを生成
With CreateObject("ScriptControl"): .Language = "JScript"
'JSON文字列をJSONオブジェクトに変換するJavascript関数
.Addcode "function getVal(num,key,res){" _
& "var json=eval('('+res+')');" _
& "var json2=json[num-1][""data""];" _
& "return json2[key];}"
'JSONオブジェクトからrateキーの値を取得
tbl.ListColumns("レート").DataBodyRange(R) = _
.CodeObject.getVal(1, "last", res)
End With
End With
Next 'ループここまで
Application.ScreenUpdating = True '画面描画を有効
*************************************************
何卒宜しくお願い致します。
No.6ベストアンサー
- 回答日時:
こんにちは。
DLL-Files.com で、Urlmon.dll (https://www.dll-files.com/)を検索・入手してみたらいかがでしょうか?
ここのサイトなら、セキュアブレインのPhishWallで調べる限りは安全と出てきます。
前述の細部のリビジョンまで同じバージョンは見つかりませんが、Ver.6.0.290 の近いバージョンがヒットします。
本来ですと、Microsoft にあってよいはすですが、あまりに古すぎるようです。
入れる場所、Windows\System32\
コマンド・プロンプトから
>regsvr32 urlmon.dll
とすると、「成功しました」のレスポンスが返るはずです。
なお、これは、あえてDOM(objHTTP)で行う方法であり、objct IE以外にもインターネットのAPIからデータを取る方法はあると思います。
No.5
- 回答日時:
何度もすみません。
試行錯誤で、ちゃんとした回答まですぐにいかないのでご不便をおかけします。私の考え方が間違っていたようです。
昨日は、以下のサイトを見つけることができませんでした。
https://support.microsoft.com/ja-jp/help/906379/ …
•URL にバインドするには、 IMoniker::BindToStorage関数を使用します。
•HTTP POST データを提供するのにには、 IStreamインターフェイスを使用します。*
•サーバー証明書に問題があります。*
•既存の HTTP 接続ではなく、新規の HTTP 接続が使用されます。
ただ、そのサイトに書かれている URLリンク先は、生きていません。
Urlmon.dll 6.0.2900.2771
これを手に入れる必要があるということです。
Windows10 にもあるのですが、それを入れてもうまくいかないような気がします。
MS以外で安全なサイトで手に入れる方法があると思いますが、今、それがどこだったか見失っています。ふつう、同じOSのバージョンなら、他のPCからコピーをとって入れるのは簡単ですが、そうでもなさそうです。
No.4
- 回答日時:
追伸です。
やはりエラーが出た場合の対処です。
>Function CreateHttpRequest() As Object
> Dim progIDs As Variant
> Dim obj As Object
この特殊な使い方を説明させていただきます。
i = 0 の [0] の部分を、途中の progID 番号から始めることができます。
たとえば、i = 8 からやってみたらどうだろうか、と考えています。
For i = 0 To UBound(progIDs)
If progIDs(i) <> "" Then
Set obj = CreateObject(Trim(progIDs(i)))
No.3
- 回答日時:
こんにちは。
>実行時エラー’-2146697208(800c0008)’
#2のアップの後で、考えてみましたが、どうやら別の問題だったようです。
「オートメーションエラーです」
https://docs.microsoft.com/en-us/previous-versio …
私は対処の仕方が分かりません。検索してみましたが、明確な解決方法は見当たりませんでした。
ただ、オートメーションエラーなら、#2のコードも、元の質問のコードも無理っぽいですから、事前に分かるように書かなくてはなりませんね。それは、ひとまず後にして、確認してください。
1.ファイルの確認
"MSXML2.XMLHTTP"
"WinHttp.WinHttpRequest.5.1"
これらがインストールされて、Register で登録されているか、疑問を持ちました。
まず、ファイルはありますか?
MSXML2.XMLHTTP
C:\Windows\system32\msxml3.dll
WinHttp.WinHttpRequest.5.1
C:\Windows\system32\winhttpcom.dll
次に、VBEditor のツール-参照設定で、
--------------------------------------
Microsoft WinHTTP Services, version 5.1
Microsoft XML, v3.0
--------------------------------------
は表示されているでしょうか?
別にチェックを入れる必要はありません。[添付画像]
(ない場合に、手に入れる方法はありますが、セキュリティが効いていないから、かなりリスクが大きいです。)
2.コードの書き換え
ダメ元ですが、ユーザー定義関数を書き加え、#2のコードまたは、元の質問にあったコードのオブジェクトを生成する部分を入れ替えてください。
もともと、実行時エラーですから、このコードは期待値は低いです。
もし、これでダメなら、もうIEオブジェクトで行うか、思い切って、DLLを再度インストールするかだと思います。OS をXPで使おうとするのには無理があるのかもしれません。
'//
Sub GetRage2()
Dim objHTTP As Object '*変数の宣言を一つ上部に書き加える
'略
For i = 0 To UBound(AryNames)
url = urlBase & AryNames(i) & "/ticker"
''With CreateObject("MSXML2.XMLHTTP" ''ここを以下の2行に書き換えます。
Set objHTTP = CreateHttpRequest() '*
With objHTTP '*
'略
EndOfLoop:
End With
Set objHTTP = Nothing '*書き加える
Next
End Sub
'//標準モジュール
Function CreateHttpRequest() As Object
Dim progIDs As Variant
Dim obj As Object
Dim i As Long
Set obj = Nothing
progIDs = Array("", _
"WinHttp.WinHttpRequest.5", _
"WinHttp.WinHttpRequest", _
"Msxml2.ServerXMLHTTP.6.0", _
"Msxml2.ServerXMLHTTP.5.0", _
"Msxml2.ServerXMLHTTP.4.0", _
"Msxml2.ServerXMLHTTP.3.0", _
"Msxml2.ServerXMLHTTP", _
"Microsoft.ServerXMLHTTP", _
"Msxml2.XMLHTTP.6.0", _
"Msxml2.XMLHTTP.5.0", _
"Msxml2.XMLHTTP.4.0", _
"Msxml2.XMLHTTP.3.0", _
"Msxml2.XMLHTTP", _
"Microsoft.XMLHTTP")
On Error Resume Next
For i = 0 To UBound(progIDs)
If progIDs(i) <> "" Then
Set obj = CreateObject(Trim(progIDs(i)))
End If
If Not obj Is Nothing Then Exit For
Next
On Error GoTo 0
Set CreateHttpRequest = obj
End Function
いつも有難うございます。
”まず、ファイルはありますか?
MSXML2.XMLHTTP
C:\Windows\system32\msxml3.dll *有ります
WinHttp.WinHttpRequest.5.1
C:\Windows\system32\winhttpcom.dll *ありません
次に、VBEditor のツール-参照設定で、
--------------------------------------
Microsoft WinHTTP Services, version 5.1 *表示されています
Microsoft XML, v3.0 *表示されています。
--------------------------------------
は表示されているでしょうか?”
C:\Windows\system32\にwinhttp.dllがあります。
No.2
- 回答日時:
こんばんは。
bitbank の方も、APIだったのですね。APIであるかどうか、分かりませんでした。
それに、今回、直接、スクリプトを動かすならともかく、VBAで既に動かしていますから、最後まで任せても大丈夫のような気がします。(気に入らないとお思いでしたら、少なくともカテゴリを変えた方がよいです)
エラーの原因は、もともとの名称の食い違いではないかと思いますが、元のマクロは、エラーを出すとマクロのループを離脱してしまうので、エラーしか分からないことになります。呼出方法を、前のものに合わせるから問題であって、#1で書いたような新規に建てるなら問題はありません。以下をみてください。 新規のシートに書き出すように出来ています。(使用環境:Excel 2007, Windows 10-32bit)
'//新規のシートで試してみてください。
Sub getRate2()
Dim url As String
Dim urlBase As String: urlBase = "https://public.bitbank.cc/"
Dim res As String
Dim i As Long
Dim AryNames
Dim aPart As Variant
Dim buf As String
AryNames = Array("btc_jpy", "xrp_jpy", "mona_jpy", "bcc_jpy")
'' "ltc_btc", "eth_btc","mona_btc","bcc_btc '日本以外は取りやめ
For i = 0 To UBound(AryNames)
url = urlBase & AryNames(i) & "/ticker"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.send
If .Status <> 200 Then GoTo EndOfLoop 'エラーを出したら、ループの最後に行く
res = .responseText
buf = Mid(res, InStr(1, res, "{""sell", vbTextCompare) + 1)
buf = Replace(buf, """", "")
buf = Replace(buf, "sell:", "")
buf = Replace(buf, "buy:", "")
aPart = Split(buf, ",")
Cells(1, 1).Resize(, 3).Value = Array("取引所", "売値", "買値")
Cells(i + 2, 1).Value = AryNames(i)
Cells(i + 2, 2).Value = Replace(aPart(0), """", "")
Cells(i + 2, 3).Value = Replace(aPart(1), """", "")
EndOfLoop:
End With
Next
End Sub
有難うございます。
試してみましたが、
実行時エラー’-2146697208(800c0008)’
オートメーションエラーです
がでてしまいました。
No.1
- 回答日時:
こんにちは。
最初に、coincheck.comの場合は、api と指定していますから、Excel 2016だったら、
既存のWebservice 関数が使えますから、マクロは必要ありません。
=WEBSERVICE("https://coincheck.com/api/rate/" & レート[@単位] & "_jpy/")
レート[@単位 の部分に、btc などが入ります。
問題は、2007 ですが、Webservice関数そのものよりも、
"https://public.bitbank.cc/"
この場所は、会員に対して公開されているものではないでしょうか。ログインして見るものなのか、こちらではエラーが発生します。
マクロのエラー自体はこちらでは不明というか、私は、DOMの動的な値を取得するノウハウを知りませんし、元のコードをみて、手間を省いて、一気に取ればと思うぐらいです。
その代わりと言ってはなんですが、これは、ビットバンクの表に出ているレート表を一括して取得する方法です。
ログイン内部での取得方法は別にありますが、ログインからするのではなく、画面からデータを取得する方法ですので、今の所は割愛しておきます。
コメントアウトしている ShDocVw は、参照設定した場合の書き方です。
'//
Sub GetBitBankData()
Dim objIE As Object ' ShDocVw.InternetExplorer
Dim strURL As String
Dim i As Long, j As Long
Dim resTbl As Object
Set objIE = CreateObject("InternetExplorer.Application")
'Set objIE = New ShDocVw.InternetExplorer
strURL = "https://bitbank.cc/"
objIE.Navigate2 strURL
Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
With objIE
Set resTbl = .document.getElementsByClassName("table-responsive")
For i = 0 To resTbl(0).Rows.Length - 1
For j = 0 To resTbl(0).Rows(i).Cells.Length - 1
Cells(i + 1, j + 1).Value = resTbl(0).Rows(i).Cells(j).innerText
Next j
Next i
End With
End Sub
ご指導有難うございます。
”問題は、2007 ですが、Webservice関数そのものよりも、
"https://public.bitbank.cc/"
この場所は、会員に対して公開されているものではないでしょうか。”
このサイトはログインしていなくてもアクセス可能です。
ちなみにexcel2007のハイパーリンクを使用するとブラウザで
レートが返信されます
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
あるあるbotに投稿したけど採用されなかったあるある募集
あるあるbotに投稿したけど採用されなかったあるあるをこちらに投稿してください
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
URLDownloadToFile でダウンロード不可
Visual Basic(VBA)
-
VBA URLDownloadToFileについて
Visual Basic(VBA)
-
パソコンのエラーコードの件
中古パソコン
-
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
実行時エラー 438になった時の...
-
エクセルエラー13型が一致しま...
-
なぜこんな初歩的なVBAのIf文で...
-
VBで構造体を使うさ際の64k...
-
ExcelVBA Range クラスの Page...
-
プロシージャ名の取得
-
実行時エラー3001「引数が間違...
-
VBAでのMATCH関数
-
VBSで変数の宣言はできないので...
-
【Excel VBA】マクロをボタンに...
-
マクロについて教えてください...
-
マクロでオートシェイプ内の文...
-
実行時エラー -'-2147417848
-
Outlook.ApplicationをCreateOb...
-
EnableEventsとOn Errorの違い
-
VBA 別シートのセルから、文字...
-
vbaのvlookup関数エラー原因を...
-
ACCESSのエラーで困っています
-
ADODB.Streamを使用してUTF-8を...
-
『実行時エラー 5 プロシージャ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
実行時エラー 438になった時の...
-
エクセルエラー13型が一致しま...
-
VBAがブレークモードになっ...
-
なぜこんな初歩的なVBAのIf文で...
-
【Excel VBA】マクロをボタンに...
-
VBSで変数の宣言はできないので...
-
VBS実行時エラー オブジェクト...
-
実行時エラー3001「引数が間違...
-
ExcelVBA Range クラスの Page...
-
ExcelVBAで、ユーザー定義型は...
-
EXCEL VBAマクロ中断でデバッグ...
-
マクロについて教えてください...
-
プロシージャ名の取得
-
ADODB.Streamを使用してUTF-8を...
-
実行時エラー -'-2147417848
-
Outlook.ApplicationをCreateOb...
-
VBAでのエラー
-
なぜエラーになるのでしょうか...
-
VBAのコードがエラーになっ...
-
[Delphi] データセットは閉じて...
おすすめ情報