excel vbaで仮想通貨のレート取得についての質問です。

excel2007,windowsXPの構成でvbaで仮想通貨レートの取得をやっておりますが、
(coincheckとbitflyerをA、bitbankとZaifをBとします)
Aはレート取得できるのですが、Bはレートが取得できません。
excel2007,windows10の構成だと同じvbaのプログラムでも取得できます。
OSの問題だと思われますが、いろいろ調べたところ
ページの要素がAはUTF-8、BはShift_jis,windows-1252でした。
プログラムで強制的にUTF-8にしてもダメでした。
お分かりになる方、ご指導お願いします。

No.2 回答者： WindFaller 回答日時： 2018/05/30 17:29

返事がないということは、おそらく、私には解決できないと思っているからだと思います。

正直、XPでの解決方法は知りません。

ただ、今、調べてみましたが、
>Bはレートが取得できません。
と言っても、UTF-8が介在する要素などはないと思います。
もし、UTF-8が介在しているなら、以下でいうなら、responceText の部分が該当します。それを、Debug.Print で取得して見せてください。

'//
Sub getRate_zaif_Ticker()
'ザイーフ
Dim url As String
Dim urlBase As String: urlBase = "https://api.zaif.jp/api/1/ticker/"
Dim res As String
Dim i As Long, k As Long, m As Long, n As Long
Dim AryNames
Dim aPart As Variant
Dim buf As String
Dim units As Variant
Dim ErrNum As Variant
AryNames = Array("btc_jpy", "xem_jpy", "mona_jpy", "mona_btc")
m = UBound(AryNames)
units = Array("last", "high", "low", "vwap", "volume", "bid", "ask")
n = UBound(units)
If Range("A1").Value <> "zaif" And Range("A1").Value = "" Then
　Range("A2").Resize(m + 1).Value = Application.Transpose(AryNames)
　Range("B1").Resize(, n + 1).Value = units
　Range("A1").Value = "Zaif"
Else
　Range("A1").CurrentRegion.Offset(1, 1).ClearContents
End If
Application.ScreenUpdating = False
For i = 0 To UBound(AryNames)
　url = urlBase & AryNames(i)
　With CreateObject("WinHttp.WinHttpRequest.5.1")
　 .Open "GET", url, False
　 .Send
　 If .Status <> 200 Then ErrNum = .Status: GoTo EndOfLoop 'エラーを出したら、ループの最後に行く
　 res = .responseText
　 If InStr(1, res, "err", vbTextCompare) = 0 Then
　　res = "[" & res & "]"
　　'Jsonオブジェクトに変換
　　With CreateObject("ScriptControl")
　　 .Language = "JScript"
　　 .Addcode "function getVal(num,key,res){" _
　　　& "var json=eval('('+res+')');" _
　　　& "return json[num-1][key];}"

　　 For k = 0 To UBound(units)
　　　Cells(i + 2, k + 2) = .CodeObject.getVal(1, units(k), res)
　　 Next k

　　End With
　　If ErrNum <> "" Then Debug.Print "Err:" & ErrNum

　 End If
EndOfLoop:
　 Application.ScreenUpdating = True
　End With
Next
End Sub
'//
Sub getRate_coincheck_Ticker()
'コインチェック
Dim url As String
Dim urlBase As String: urlBase = "https://coincheck.com/api/rate/"
Dim res1 As String
Dim i As Long, j As Long
Dim AryNames
'Dim aPart As Variant
Dim buf As String
'Dim Titles As Variant
Dim ErrNum As Variant
Dim units As Variant
AryNames = Array("Bitcoin", "Ethereum", "Ether Classic", "Lisk", "Factom", "Monero", "Augur", "Ripple", "Zcash", "NEM", "Litecoin", "DASH")
units = Array("btc", "eth", "etc", "lsk", "fct", "xmr", "rep", "xrp", "zec", "xem", "ltc", "dash")
If Cells(1, 1).Value = "" And Cells(1, 1).Value = "" Then
　Cells(1, 1).Value = "coincheck"
　Cells(1, 2).Value = "Rate"
　j = UBound(AryNames)
　Cells(2, 1).Resize(j + 1).Value = Application.Transpose(AryNames)
Else
　Cells(1, 1).CurrentRegion.Offset(1, 1).ClearContents
End If
Application.ScreenUpdating = False
For i = 0 To UBound(units)
　url = urlBase & units(i) & "_jpy"
　With CreateObject("WinHttp.WinHttpRequest.5.1")
　 .Open "GET", url, False
　 .Send

　 If .Status <> 200 Then ErrNum = .Status: GoTo EndOfLoop 'エラーを出したら、ループの最後に行く
　 res1 = .responseText
　 If InStr(1, res1, "err", vbTextCompare) = 0 Then
　　buf = res1
　　buf = Replace(buf, "{", "")
　　buf = Replace(buf, "}", "")
　　buf = Replace(buf, """rate"":", "")
　　buf = Replace(buf, """", "")
　　Cells(i + 2, 2).Value = buf
　　Application.ScreenUpdating = True
　 End If
EndOfLoop:
　End With
　If ErrNum <> "" Then Debug.Print "Err:" & ErrNum
Next
Application.ScreenUpdating = True
End Sub

'//

No.1 回答者： WindFaller 回答日時： 2018/05/24 18:06

こんにちは。

前回の回答者です。

>excel2007,windowsXPの構成でvbaで仮想通貨レートの取得をやっております

前回から、どの程度話が変わったのかはわかりませんが、最初に、XP で、今のコードを実現しようとしても無理ではないかと今でも、思っています。前にも書いたかもしれませんが、ジャンク屋さんで、2～3万円で、Windows 7 入りのPCは手に入りますから、XPで何とかしたいというよりも、そちらで考えたほうがより確実だと思います。

前回、プログラムファイルが足らないという結果に至ったのではなかったでしょうか。

CreateObject("WinHttp.WinHttpRequest.5.1")
CreateObject("MSXML2.XMLHTTP")
両方共、実行時エラーがでるということで、ある特定のファイルが足りないので、それをダウンロードして、System32 に入れる、その後、ご質問者さんは、はたして、Regsrvr32 で「成功」にまでこぎつけたのは不明なままで、解決せずに終わったという記憶が残っています。

>OSの問題だと思われますが、
>いろいろ調べたところ
>ページの要素がAはUTF-8、BはShift_jis,windows-1252でした。
>プログラムで強制的にUTF-8にしてもダメでした。

つまり、受信はしているという意味なのでしょうか？
UTF-8とは、受信後のJSONファイルの後処理の話でしょうか？もし、JSONファイルの受信があるなら、VBAコードと、Debug.Print で、その生の記録を見せていただけませんか？データは、別に秘匿性があるわけではないと思います。

一般のWebサイトで出ているVBAのJSONファイルの処理は、JSCript で処理するわけですが、プログラムで強制的にUTF-8という表現も疑問が残ってしまいます。私は、JScript で書いたほうがよいと思っていましたが、どう考えても、VBAのほうが簡単だと思います。それから、VBAて処理するにしろ、しないにしろ、UTF-8 に変更させるのではなく、UTF-8のデコードをするのだと思います。いずれにしても、UTFのままでは読めないからです。