「夫を成功」へ導く妻の秘訣 座談会

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 '画面描画を有効

*************************************************

何卒宜しくお願い致します。

A 回答 (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からデータを取る方法はあると思います。
「excel vbaでレート取得についてで」の回答画像6
    • good
    • 0
この回答へのお礼

期間が空いて申し訳ございません。
ご指示通り、やってみたけど
うまくいきませんでした。

お礼日時:2018/04/05 18:56

何度もすみません。

試行錯誤で、ちゃんとした回答まですぐにいかないのでご不便をおかけします。

私の考え方が間違っていたようです。
昨日は、以下のサイトを見つけることができませんでした。

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からコピーをとって入れるのは簡単ですが、そうでもなさそうです。
    • good
    • 0
この回答へのお礼

いろいろ調べて頂き有難うございます。

お時間のある時にでも何か情報があれば幸いです。

お礼日時:2018/03/14 18:08

追伸です。


やはりエラーが出た場合の対処です。

>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)))
    • good
    • 0

こんにちは。



>実行時エラー’-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
「excel vbaでレート取得についてで」の回答画像3
    • good
    • 0
この回答へのお礼

いつも有難うございます。

”まず、ファイルはありますか?
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があります。

お礼日時:2018/03/14 09:38

こんばんは。



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
    • good
    • 0
この回答へのお礼

有難うございます。

試してみましたが、

実行時エラー’-2146697208(800c0008)’
オートメーションエラーです

がでてしまいました。

お礼日時:2018/03/13 10:40

こんにちは。



最初に、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
    • good
    • 0
この回答へのお礼

ご指導有難うございます。

”問題は、2007 ですが、Webservice関数そのものよりも、
"https://public.bitbank.cc/"
この場所は、会員に対して公開されているものではないでしょうか。”

このサイトはログインしていなくてもアクセス可能です。
ちなみにexcel2007のハイパーリンクを使用するとブラウザで
レートが返信されます

お礼日時:2018/03/12 09:33

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


人気Q&Aランキング