新規投稿

vbaからコマンドラインツールでフリーズ

Tokunaga

2016年12月20日 02:14

ExcelVBAからコマンドラインを実行してJSONデータを取得したいと考えています。

下記のようなコードで100件程度でしたら問題なく動くのですが、

2000件を超えるアプリからダウンロードしようとすると、

応答なしになってフリーズしてしまいます。

何か間違えているのだと思いますが、よろしくお願いいたします。

―　また、シェルのStatusを拾えないようなので、Line処理にしています。

'JSON取得処理
Dim wWSH As Object, wExec As Object
Dim wCmd As String, wResult As Variant
Set wWSH = CreateObject("WScript.Shell")
wCmd = """" & ThisWorkbook.Path & "\cli-kintone.exe"""
wCmd = wCmd & " -a " & wAID & " -d DOMAIN -u USERID -p PASSWORD -o json -e sjis"
' wCmd = wCmd & " >" & """" & ThisWorkbook.Path & "\test.json"""
' wCmd = wCmd & " 2>" & """" & ThisWorkbook.Path & "\error.txt"""
Debug.Print wCmd
Set wExec = wWSH.Exec("%ComSpec% /c " & wCmd)

gi = 0
wResult = wExec.StdOut.ReadLine
Do While Not (wExec.StdOut.AtEndOfStream)
gi = gi + 1
Debug.Print gi
wResult = wResult & wExec.StdOut.ReadLine
Loop
Set wExec = Nothing
Set wWSH = Nothing

Debug.Print wResult

8件のコメント

門屋　亮 2016年12月20日 04:06

Tokunagaさんこんにちは。

VBAは詳しくないのですが、Execコマンドが標準出力にためるバッファは4096バイトしかないので、

それ以上のデータを読み込もうとすると固まると書いてありました。

http://d.hatena.ne.jp/calotocen/20090409/p1

Tokunaga 2016年12月20日 07:46

門屋　亮さん

なるほど、情報ありがとうございます。

ひとまず、無理やりですが、外部ファイルに出力するcli-kintoneコマンドのbatファイルを生成して、

batファイルをRunで実行した後に、出力されたファイルを読み込むような方法にしようと思います。

ありがとうございました。

milkyway0307 2016年12月21日 00:42

Tokunaga様

accessのvbaでしかやったことはないですが、vbaから直接kintoneにxmlhttprequestをしてみてはいかがでしょう？

Tokunaga 2016年12月21日 01:14

milkyway0307さん

ありがとうございます。

そうですね、xmlhttprequestにしていて、1回のリクエスト500件ということにつまづいて、

コマンドラインに切り替えた次第ですが、もう少し勉強してみます。

milkyway0307 2016年12月21日 02:03

Tokunaga様

ループをかければ、500件の制限はクリアできるはずです。

以下はAccessのVBAのコードとして作った関数ですが、参考になれば幸いです。

Access用なので、DAOでテーブルに保存するような処理をしていますが、ここをシートに書き換えればエクセルでも使えるのではないでしょうか。

※エクセルに読み込むTipsのほうがたくさん検索に引っかかりやすいとは思います。

strAuthentication ←認証情報

strDomain ←ドメイン

'------------------------------------------------------------------------
'GETしてテーブルに保存
'------------------------------------------------------------------------
Public Sub kintoneGETtoTable(appId As String, strQuery As String, strTable As String, ByRef varFields() As Variant, Optional lngOffset As Long = 0)

'--------------------------------------------------------------------
' 変数定義
'--------------------------------------------------------------------
' XMLHTTP用
Dim objHttpReq As Object ' XMLHTTPオブジェクト
Dim strURL As String ' アクセス先URL
Dim strResponseText As String ' レスポンステキスト
Dim objResponse As New cJobject ' strResoponseText をパースしたJSON
Dim objRecords As New cJobject ' パースしたrecords
Dim strQueryParameter As String ' クエリパラメータ
Dim strFields As String ' フィールド指定URL記述
Dim i, j As Integer ' ループ用

Dim intLimit As Integer ' １回のAPIでアクセスするレコード件数
intLimit = 500 ' GETなら最大500, PUTなら最大100

' テーブル操作
Dim db As DAO.Database
Dim rs As DAO.Recordset

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM " & strTable
DoCmd.SetWarnings True

Set db = CurrentDb()
Set rs = db.OpenRecordset(strTable)

'------------------------------------------------------------------
' 取得フィールドの設定
'------------------------------------------------------------------
strFields = "&fields[0]=$id"
For i = 0 To UBound(varFields)
strFields = strFields & "&fields[" & i + 1 & "]=" & varFields(i)
Next

' 全レコード取得するためにループするならここから
Do
'------------------------------------------------------------------
' 検索文字付きURLを作成する
'------------------------------------------------------------------
strQueryParameter = URL_Encode(strQuery & " order by $id asc limit " & intLimit & " offset " & lngOffset)
strURL = "https://" & strDomain & "/k/v1/records.json?&app=" & appId & "&query=" & strQueryParameter & strFields

'------------------------------------------------------------------
' XMLHTTP オブジェクトを生成する
'------------------------------------------------------------------
Set objHttpReq = Nothing
Set objHttpReq = CreateHttpRequest()
objHttpReq.Open "GET", strURL, False

'------------------------------------------------------------------
' XMLHTTP のリクエストヘッダーを指定する
'------------------------------------------------------------------
' ログイン認証
objHttpReq.setRequestHeader "X-Cybozu-Authorization", strAuthentication
' Basic 認証
objHttpReq.setRequestHeader "Authorization", "Basic " & strAuthentication

'ドメイン名：ポート番号
objHttpReq.setRequestHeader "Host", strDomain + ":443"
'キャッシュ対策（常にレスポンスが取得できる状態にする）
objHttpReq.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"

'------------------------------------------------------------------
' リクエストを送信する
'------------------------------------------------------------------
objHttpReq.send Null

'------------------------------------------------------------------
' レスポンスを取得する
'------------------------------------------------------------------
'レスポンス情報を変数に格納する
strResponseText = objHttpReq.responseText
Set objResponse = JSONParse(strResponseText)
Set objRecords = objResponse.child("records")

For i = 1 To objRecords.children.Count
rs.AddNew
rs![$id] = objRecords.children(i).child("$id").child("value").value
For j = 0 To UBound(varFields)
rs.Fields(CStr(varFields(j))) = objRecords.children(i).child(CStr(varFields(j))).child("value").value
Next
rs.Update

Next

lngOffset = lngOffset + intLimit

Loop While objRecords.children.Count = intLimit

' 後始末
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

End Sub

Tokunaga 2016年12月21日 03:38

milkyway0307さん

詳細なコードをありがとうございます。非常に助かります。

細かい話ですが、取得ループ中にレコード追加・削除された場合に、offsetの関連で、

結果としてレコードの重複あるいは欠落が起きたりしませんでしょうか？

milkyway0307 2016年12月21日 06:05

Tokunaga様

詳しいことは分かりませんが、ループ中にレコード追加・削除される際には可能性がゼロとは言えないと思います。

ただ、そのリスク自体はcli-kintoneでも同じなのではないでしょうか。

本当に追加・削除されないようにするためには、最初にアクセス権を変更して編集・削除権限をはずし、GETしたあとに改めて編集・削除権限を付与するようにすればよいかと思いますが。

https://cybozudev.zendesk.com/hc/ja/articles/201941854-%E3%83%AC%E3%82%B3%E3%83%BC%E3%83%89%E3%81%AE%E3%82%A2%E3%82%AF%E3%82%BB%E3%82%B9%E6%A8%A9%E3%81%AE%E5%A4%89%E6%9B%B4

Tokunaga 2016年12月21日 08:09

milkyway0307さん

なるほど、承知いたしました。いろいろと情報ありがとうございました。

サインインしてコメントを残してください。