TimeTrackerのWebAPIを活用し、VBAでExcelにTimeTrackerのプロジェクト一覧およびプロジェクトの説明（進捗や状況を記入するメモ欄）を出力するサンプルコードを紹介します。

参考サイト

WebAPIヘルプ：プロジェクト一覧の取得 | TimeTracker NX WebApi ヘルプ 

APIキーを生成する： ユーザー設定を変更する | TimeTracker RX ヘルプ 

============================================ 

設定値（ご利用環境に合わせて変更してください）

============================================

Const BASE_URL As String = "https://<YOUR_HOST>/<YOUR_TENANT>/api/project/projects"

Const LOGIN_ID As String = "<LOGIN_ID>"

Const LOGIN_PW As String = "<PASSWORD>"

---------------------------------------------------------------------------------------------------------------------------

Option Explicit

Sub GetProjects()

    Dim url As String
    url = "https://<YOUR_HOST>/<YOUR_TENANT>/api/project/projects"

    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    http.setOption 2, 13056

    Dim cred As String
    cred = B64Enc("<LOGIN_ID>:<PASSWORD>")
    http.Open "GET", url, False
    http.setRequestHeader "Authorization", "Basic " & cred
    http.setRequestHeader "Accept", "application/json"

    On Error GoTo ErrHandler
    http.Send
    On Error GoTo 0

    If http.Status <> 200 Then
        MsgBox "HTTP " & http.Status & vbCrLf & http.responseText, vbCritical
        Exit Sub
    End If

    Dim json As String
    json = http.responseText

    Dim ws As Worksheet
    Set ws = ActiveSheet
    ws.Cells.Clear

    ws.Cells(1, 1).Value = "No"
    ws.Cells(1, 2).Value = "Code"
    ws.Cells(1, 3).Value = "Project Name"
    ws.Cells(1, 4).Value = "Manager"
    ws.Cells(1, 5).Value = "Organization"
    ws.Cells(1, 6).Value = "Start Date"
    ws.Cells(1, 7).Value = "Finish Date"
    ws.Cells(1, 8).Value = "Description"
    ws.Range("A1:H1").Font.Bold = True

    Dim pos As Long
    Dim row As Long
    row = 2

    pos = InStr(json, """data"":[")
    If pos = 0 Then
        MsgBox "data not found", vbCritical
        Exit Sub
    End If

    Dim i As Long
    i = 1

    Do
        Dim namePos As Long
        namePos = InStr(pos, json, """name"":""")
        If namePos = 0 Then Exit Do

        Dim projName As String
        projName = ExtractValue(json, namePos)

        Dim code As String
        Dim codePos As Long
        codePos = InStrRev(json, """code"":""", namePos)
        If codePos > 0 And namePos - codePos < 200 Then
            code = ExtractValue(json, codePos)
        Else
            code = ""
        End If

        Dim mgr As String
        mgr = FindField(json, namePos, "managerName")

        Dim org As String
        org = FindField(json, namePos, "organizationName")

        Dim sDate As String
        sDate = FindField(json, namePos, "plannedStartDate")
        If Len(sDate) > 10 Then sDate = Left(sDate, 10)

        Dim fDate As String
        fDate = FindField(json, namePos, "plannedFinishDate")
        If Len(fDate) > 10 Then fDate = Left(fDate, 10)

        Dim desc As String
        desc = FindField(json, namePos, "description")

        ws.Cells(row, 1).Value = i
        ws.Cells(row, 2).Value = code
        ws.Cells(row, 3).Value = projName
        ws.Cells(row, 4).Value = mgr
        ws.Cells(row, 5).Value = org
        ws.Cells(row, 6).Value = sDate
        ws.Cells(row, 7).Value = fDate
        ws.Cells(row, 8).Value = desc

        row = row + 1
        i = i + 1
        pos = namePos + Len(projName) + 10
    Loop

    ws.Columns("A:H").AutoFit

    MsgBox (row - 2) & " projects retrieved.", vbInformation

    Exit Sub

ErrHandler:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description, vbCritical

End Sub

Function ExtractValue(ByVal json As String, ByVal keyPos As Long) As String
    Dim vStart As Long
    vStart = InStr(keyPos, json, ":""") + 2
    Dim vEnd As Long
    vEnd = InStr(vStart, json, """")
    If vEnd > vStart Then
        ExtractValue = Mid(json, vStart, vEnd - vStart)
    Else
        ExtractValue = ""
    End If
End Function

Function FindField(ByVal json As String, ByVal fromPos As Long, ByVal fieldName As String) As String
    Dim fPos As Long
    fPos = InStr(fromPos, json, """" & fieldName & """:""")
    If fPos > 0 And fPos - fromPos < 1000 Then
        FindField = ExtractValue(json, fPos)
    Else
        Dim fPos2 As Long
        fPos2 = InStr(fromPos, json, """" & fieldName & """:")
        If fPos2 > 0 And fPos2 - fromPos < 1000 Then
            Dim cPos As Long
            cPos = fPos2 + Len(fieldName) + 3
            Dim cEnd As Long
            cEnd = InStr(cPos, json, ",")
            Dim cEnd2 As Long
            cEnd2 = InStr(cPos, json, "}")
            If cEnd2 > 0 And (cEnd = 0 Or cEnd2 < cEnd) Then cEnd = cEnd2
            If cEnd > cPos Then
                FindField = Mid(json, cPos, cEnd - cPos)
            Else
                FindField = ""
            End If
        Else
            FindField = ""
        End If
    End If
End Function

Function B64Enc(ByVal txt As String) As String
    Dim b() As Byte
    b = StrConv(txt, vbFromUnicode)
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    Dim nd As Object
    Set nd = xDoc.createElement("b64")
    nd.DataType = "bin.base64"
    nd.nodeTypedValue = b
    B64Enc = Replace(Replace(nd.text, vbCr, ""), vbLf, "")
    Set nd = Nothing
    Set xDoc = Nothing
End Function

---------------------------------------------------------------------------------------------------------------------------

私はエンジニアではありませんが、生成AIの力を借りて、プログラムコードを書きました。

いわゆる「バイブコーディング」の実践です。

デンソークリエイトはAIエージェントも販売しています。ご興味ある方はお問い合わせください。

 DC Agentiqs - 開発の全工程を、AIが一気通貫で支援｜DC Agentiqs