スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

NozbeをVBAで動かす:プロジェクト&タスクの取得

Nozbeに登録されているプロジェクトやタスクを取得するソースです。

ちなみに、sAPIKeyという変数名(String型)で、CONSTとかで以下を動かすモジュールに変数を作成してください。
その変数にAPIKeyを代入しておいてください。

※ APIKeyの取得は、この1つ前の記事に書いております。あわせてご参照ください。

’プロジェクトを取得する ・・・ついでに、タスクを取得する部分も入れ込んでます
 Public Function GetNozbeProjects()
    Dim xmlHTTP As Object
    Dim txt As String
    Dim bufs() As String, itms() As String, vals() As String
    
    Set xmlHTTP = getXMLHTTP()
    If xmlHTTP Is Nothing Then
        MsgBox "XMLHTTPオブジェクトの生成に失敗しました。", vbExclamation
        Exit Function
    End If
    xmlHTTP.Open "GET", "http://www.nozbe.com/api/projects/key-" & sAPIKey, False
    xmlHTTP.send ""
    txt = xmlHTTP.responseText
    
    '*-- JSONデータの処理 --*
    txt = Mid(txt, 3, Len(txt) - 4) '両端の[{ }]を除去
    bufs = Split(txt, "},{")
    
    Dim i As Integer, j As Integer
    For i = 0 To UBound(bufs)
        Debug.Print i & "つ目のアイテム"
        itms = Split(bufs(i), ",")
        For j = 0 To UBound(itms)
            vals = Split(itms(j), ":")
            If InStr(vals(0), "name") > 0 Then
                vals(1) = UNItoSTR(vals(1)) ' UNICODEの処理
            End If
            Debug.Print vals(0), vals(1)
        Next j
        
        GetNozbeTasks Split(itms(0), ":")(1) ’プロジェクトIDを渡して、そのプロジェクトのタスクを取得
    Next i
    
    Set xmlHTTP = Nothing
End Function
’タスク情報を取得(引数=プロジェクトID)
Public Sub GetNozbeTasks(ByVal PJID As String)
    Dim xmlHTTP As Object
    Dim txt As String
    Dim bufs() As String, itms() As String, vals() As String
    
    'プロジェクトIDにダブルコーテが付いてたら削除
    If Left(PJID, 1) = """" Then
        PJID = Mid(PJID, 2, Len(PJID) - 2) '両端の"を除去
    End If
    
    Set xmlHTTP = getXMLHTTP()
    If xmlHTTP Is Nothing Then
        MsgBox "XMLHTTPオブジェクトの生成に失敗しました。", vbExclamation
        Exit Sub
    End If
    xmlHTTP.Open "GET", "http://www.nozbe.com/api/actions/what-project/id-" & PJID & "/key-" & sAPIKey, False
    xmlHTTP.send ""
    txt = xmlHTTP.responseText
    '*-- JSONデータの処理 --*
    txt = Mid(txt, 3, Len(txt) - 4) '両端の[{ }]を除去
    bufs = Split(txt, "},{")
    
    Dim i As Integer, j As Integer
    For i = 0 To UBound(bufs)
        '1つ目のアイテム
        itms = Split(bufs(i), ",")
        Debug.Print i + 1 & "つ目のアイテム"
        For j = 0 To UBound(itms)
            vals = Split(itms(j), ":")
            If InStr(vals(0), "name") > 0 Then
                vals(1) = UNItoSTR(vals(1)) ' UNICODEの処理
            End If
            Debug.Print vals(0), vals(1)
        Next j
    Next i
    Set xmlHTTP = Nothing
End Sub
'-- UNICODE -> STRINGに変換 --------------------
Public Function UNItoSTR(ByVal sUNI As String) As String
    Dim uni(1) As Byte, str As String
    Dim i As Integer
    
    sUNI = RepStr(sUNI, "\/", "/")
    
    For i = 1 To Len(sUNI)
        If Mid(sUNI, i, 2) = "\u" Then
            uni(0) = CLng("&H" & Mid(sUNI, i + 4, 2))
            uni(1) = CLng("&H" & Mid(sUNI, i + 2, 2))
            str = str & CStr(uni)
            i = i + 5
        Else
            str = str & Mid(sUNI, i, 1)
        End If
    Next i
    
    UNItoSTR = str
End Function
'-- WEBの情報を取ってくるオブジェクト ---------------
Public Function getXMLHTTP() As Object
  Dim L As Long
  On Error Resume Next
  'セキュリティレベル & パフォーマンスの高い MSXML4を優先して作成する。
  '対応バージョンのXMLHTTPがインストールされていない場合は、
  '下位バージョンのXMLHTTPオブジェクトの生成を試みる。
  For L = 0 To 4
    Select Case L
     Case 0
      Set getXMLHTTP = CreateObject("Msxml2.XMLHTTP.4.0")
     Case 1
      Set getXMLHTTP = CreateObject("Msxml2.XMLHTTP.3.0")
     Case 2
      Set getXMLHTTP = CreateObject("Msxml2.XMLHTTP.2.6")
     Case 3
      Set getXMLHTTP = CreateObject("Msxml2.XMLHTTP")
     Case 4
      Set getXMLHTTP = CreateObject("Microsoft.XMLHTTP")
    End Select
    If Not getXMLHTTP Is Nothing Then
        Exit For
    End If
  Next
End Function
スポンサーサイト

トラックバック

コメント

コメントを残す

Secret



上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。