[go: up one dir, main page]
More Web Proxy on the site http://driver.im/

情シス仕事の備忘録

自身の備忘録を兼ねて、情シス仕事で役に立ちそうな情報を掲載しています

Excel VBA ⇔ Cloud データ取得・加工(freee会計API)２

VBA⇔Cloud アプリ開発

 

前の記事の続きになります。

 

 

Excel VBAでfreee会計の取引データを取得・加工する

メインプロシージャ

データ取得・加工のメインとなるプロシージャのソースです。

  • API実行時に必要な情報(Client IDや事業所ID等)はparamシートにあり、これをAPI実行に関するサブプロシージャ(writeMstData(), writeDealsData())に渡している。
  • 最後のデータ結合のSELECT文に関して、取引先・品目・部門は未設定の場合を考慮して外部結合としている。
Private Sub Main()

    '変数宣言(excel関連)
    Dim wb As Workbook
    Dim ws_param As Worksheet
    
    '変数宣言(処理変数)
    Dim keys As Variant
    
    '変数宣言(SQL関連)
    Dim sql As String
    
    'ワークシートの設定&初期化
    Set wb = ThisWorkbook
    Set ws_param = wb.Worksheets("param")
    
    '取引先マスタ出力(20項目(zipcode)以降はaddress_attributes等の子項目)
    keys = Array("id", "code", "company_id", "name", "update_date", "available", _
      "shortcut1", "shortcut2", "org_code", "country_code", "long_name", _
      "name_kana", "default_title", "phone", "contact_name", "email", _
      "payer_walletable_id", "transfer_fee_handling_side", "qualified_invoice_issuer", _
      "invoice_registration_number", _
      "zipcode", "prefecture_code", "street_name1", "street_name2", _
      "bank_name", "bank_name_kana", "bank_code", "branch_name", "branch_kana", _
      "branch_code", "account_type", "account_number", "account_name", _
      "long_account_name")
    Call writeMstData(wb, ws_param, keys, "partners")
    
    '勘定科目マスタ出力(categoriesは複数値)
    keys = Array("id", "name", "tax_code", "shortcut", "shortcut_num", _
      "code", "default_tax_code", "account_category", "account_category_id", "categories", _
      "available", "walletable_id", "group_name", "group_id", "corresponding_income_name", _
      "corresponding_income_id", "corresponding_expense_name", "corresponding_expense_id")
    Call writeMstData(wb, ws_param, keys, "account_items")
    
    '税区分マスタ出力
    keys = Array("code", "name", "name_ja")
    Call writeMstData(wb, ws_param, keys, "taxes")
    
    '品目マスタ出力
    keys = Array("id", "company_id", "name", "update_date", "available", _
      "shortcut1", "shortcut2", "code")
    Call writeMstData(wb, ws_param, keys, "items")
    
    '部門マスタ出力
    keys = Array("id", "company_id", "name", "long_name", "shortcut1", "shortcut2")
    Call writeMstData(wb, ws_param, keys, "sections")

    '取引データ出力(13項目(id)以降はdetailsの子項目)
    keys = Array("id", "company_id", "issue_date", "due_date", "amount", _
      "due_amount", "type", "partner_id", "partner_code", "ref_number", _
      "status", "deal_origin_name", "id", "account_item_id", "tax_code", _
      "item_id", "section_id", "amount", "vat", "description", "entry_side")
    Call writeDealsData(wb, ws_param, keys, "deals")
    
    '取引データと各マスタを結合して出力(取引先&品目&部門は未設定時を考慮)
    sql = "select "
    sql = sql & "add_sec.id as 取引ID, add_sec.issue_date as 発生日, "
    sql = sql & "add_sec.due_date as 支払期日, add_sec.type as 収支, "
    sql = sql & "add_sec.partner_id as 取引先ID, add_sec.取引先CD, add_sec.取引先名, "
    sql = sql & "add_sec.status as 決済状況, add_sec.dtl_id as 取引明細ID, "
    sql = sql & "add_sec.dtl_account_item_id as 勘定科目ID, "
    sql = sql & "acc.name as 勘定科目, acc.account_category as 科目分類, "
    sql = sql & "add_sec.dtl_tax_code as 税区分CD, tax.name_ja as 税区分, "
    sql = sql & "add_sec.dtl_item_id as 品目ID, add_sec.品目, "
    sql = sql & "add_sec.dtl_section_id as 部門ID, add_sec.部門, "
    sql = sql & "add_sec.dtl_amount as 税込金額, add_sec.dtl_vat as 消費税, "
    sql = sql & "add_sec.dtl_description as 備考, add_sec.dtl_entry_side as 貸借 "
    sql = sql & "from "
    sql = sql & "(select add_itm.*, iif(isnull(sec.name), '部門なし', sec.name) as 部門 from "
    sql = sql & "(select add_prt.*, iif(isnull(itm.name), '品目なし', itm.name) as 品目 from "
    sql = sql & "(select deal.*, iif(isnull(prt.code), '取引先CDなし', prt.code) as 取引先CD, "
    sql = sql & "iif(isnull(prt.name), '取引先名なし', prt.name) as 取引先名 "
    sql = sql & "from [deals$] as deal left join [partners$] as prt "
    sql = sql & "on deal.partner_id = prt.id "
    sql = sql & ") as add_prt left join [items$] as itm "
    sql = sql & "on add_prt.dtl_item_id = itm.id "
    sql = sql & ") as add_itm left join [sections$] as sec "
    sql = sql & "on add_itm.dtl_section_id = sec.id "
    sql = sql & ") as add_sec, [account_items$] as acc, [taxes$] as tax "
    sql = sql & "where "
    sql = sql & "add_sec.dtl_account_item_id = acc.ID "
    sql = sql & "and add_sec.dtl_tax_code = tax.code "
    sql = sql & "and " & CLng(Replace(TextBox1.Value, "-", "")) & _
      "<= clng(format(add_sec.issue_date, 'yyyymmdd'))"
    sql = sql & "and clng(format(add_sec.issue_date, 'yyyymmdd')) <= " & _
      CLng(Replace(TextBox2.Value, "-", "")) & " "
    sql = sql & "order by "
    sql = sql & "add_sec.issue_date, add_sec.id, add_sec.dtl_id "
    Call writeSearchData(wb, sql)
  
End Sub

 

上記ソース内ではSELECT文が分かり辛いため、以下に改めて記載します。

select
  add_sec.id as 取引ID, add_sec.issue_date as 発生日, 
  add_sec.due_date as 支払期日, add_sec.type as 収支, 
  add_sec.partner_id as 取引先ID, add_sec.取引先CD, add_sec.取引先名, 
  add_sec.status as 決済状況, add_sec.dtl_id as 取引明細ID, 
  add_sec.dtl_account_item_id as 勘定科目ID, 
  acc.name as 勘定科目, acc.account_category as 科目分類, 
  add_sec.dtl_tax_code as 税区分CD, tax.name_ja as 税区分, 
  add_sec.dtl_item_id as 品目ID, add_sec.品目, 
  add_sec.dtl_section_id as 部門ID, add_sec.部門, 
  add_sec.dtl_amount as 税込金額, add_sec.dtl_vat as 消費税, 
  add_sec.dtl_description as 備考, add_sec.dtl_entry_side as 貸借 
from 
  (select add_itm.*, iif(isnull(sec.name), '部門なし', sec.name) as 部門 from 
    (select add_prt.*, iif(isnull(itm.name), '品目なし', itm.name) as 品目 from 
      (select deal.*, iif(isnull(prt.code), '取引先CDなし', prt.code) as 取引先CD, 
        iif(isnull(prt.name), '取引先名なし', prt.name) as 取引先名 
        from [deals$] as deal left join [partners$] as prt on deal.partner_id = prt.id 
      ) as add_prt left join [items$] as itm on add_prt.dtl_item_id = itm.id 
    ) as add_itm left join [sections$] as sec on add_itm.dtl_section_id = sec.id 
  ) as add_sec, [account_items$] as acc, [taxes$] as tax
where 
  add_sec.dtl_account_item_id = acc.id 
  and add_sec.dtl_tax_code = tax.code 
  and [発生日(開始)] <= clng(format(add_sec.issue_date, 'yyyymmdd')) 
  and clng(format(add_sec.issue_date, 'yyyymmdd')) <= [発生日(終了)]
order by 
 add_sec.issue_date, add_sec.id, add_sec.dtl_id;

 

API実行に関するサブプロシージャ

メインプロシージャから呼び出しているAPI実行(各マスターや取引データの取得)に関するサブプロシージャ(2点)のソースです。

  • 一覧データを取得する前に都度トークンを更新し、その情報(paramシートのaccess_token)を使用している。
  • writeMstData()：
    • 勘定科目のcategoriesは複数項目のため、カンマ区切りの一項目に変換して出力している。
    • 取引先の住所情報や銀行口座情報はサブ項目があるためため、サブ項目を展開して出力している。
  • writeDealsData()：
    • 一度に返す件数の上限が100件のため、ページ送りの処理を行っている(ページ数=[全件数]÷[一度に返す件数の上限]の商)。
    • 全件数は取引一覧取得結果内の”meta”の”total_count”に格納されている。
Private Sub writeMstData(wb As Workbook, ws_param As Worksheet, keys As Variant, label As String)

  '変数宣言(API関連)
  Dim apiMethod As String
  Dim apiUrl As String
  Dim apiParams As String
  Dim apiHeaders As New Dictionary
  Dim apiJson As Object
  
  '変数宣言(Excel関連)
  Dim ws_data As Worksheet
  
  '変数宣言(処理変数)
  Dim cnt_row As Long 'apiJsonから取得するデータの行カウンタ
  Dim cnt_col As Long 'apiJsonから取得するデータの列カウンタ

  'トークン更新
  Call refreshTokens(ws_param)
  
  'データ検索用の設定
  apiMethod = "GET"
  apiUrl = "https://api.freee.co.jp/api/1/" & label
  If label = "taxes" Then
    apiUrl = apiUrl & "/codes"
  End If
  apiParams = "?company_id=" & ws_param.Cells(6, 2).Value
  If label = "partners" Or label = "items" Then
    apiParams = apiParams & "&limit=3000"
  End If
  apiHeaders.RemoveAll
  apiHeaders.Add "Authorization", "Bearer " & ws_param.Cells(1, 2).Value
  
  'ワークシートの設定&初期化
  Set ws_data = wb.Worksheets(label)
  ws_data.Rows("1:" & ws_data.Range("A" & ws_data.Rows.Count).End(xlUp).Row).Delete
  
  'データ検索
  Set apiJson = callRestApi(apiMethod, apiUrl, apiParams, apiHeaders)
  
  'データ出力(タイトル行)
  For cnt_col = 0 To UBound(keys)
    ws_data.Cells(1, cnt_col + 1).Value = keys(cnt_col)
  Next cnt_col
  
  'データ出力(データ行)
  For cnt_row = 0 To apiJson(label).Count - 1
    For cnt_col = 0 To UBound(keys)
    
      'account_itemsのcategories(複数値項目)はカンマ区切りデータを出力
      If label = "account_items" And keys(cnt_col) = "categories" Then
        ws_data.Cells(cnt_row + 2, cnt_col + 1).Value = _
          concatString(apiJson, label, "categories", cnt_row, cnt_col)
      
      'partnersの20-24項目はaddress_attributesのサブ項目を出力
      ElseIf label = "partners" And 19 <= cnt_col And cnt_col <= 23 Then
        ws_data.Cells(cnt_row + 2, cnt_col + 1).Value = _
          apiJson(label)(cnt_row + 1)("address_attributes")(keys(cnt_col))

      'partnersの25項目以降はpartner_bank_account_attributesのサブ項目を出力
      ElseIf label = "partners" And 24 <= cnt_col Then
        ws_data.Cells(cnt_row + 2, cnt_col + 1).Value = _
          apiJson(label)(cnt_row + 1)("partner_bank_account_attributes")(keys(cnt_col))
          
      Else 'その他の項目を出力
        ws_data.Cells(cnt_row + 2, cnt_col + 1).Value = apiJson(label)(cnt_row + 1)(keys(cnt_col))
      End If
      
    Next cnt_col
  Next cnt_row

End Sub


Private Sub writeDealsData(wb As Workbook, ws_param As Worksheet, keys As Variant, label As String)

  '変数宣言(API関連)
  Dim apiMethod As String
  Dim apiUrl As String
  Dim apiParams As String
  Dim apiHeaders As New Dictionary
  Dim apiJson As Object
  
  '変数宣言(Excel関連)
  Dim ws_data As Worksheet
  
  '変数宣言(処理変数)
  Dim cnt_col As Long 'apiJsonから取得するデータの列カウンタ
  Dim max_row As Long 'apiJsonのtotal_countから取得する全データの行数(ページ跨ぎ考慮)
  Dim cnt_res As Long '出力するExcelの行数カウンタ
  Dim max_page As Long 'max_row/ページ上限件数(100)(ページ跨ぎ考慮)
  Dim cnt_page As Long 'ページカウンタ

  'トークン更新
  Call refreshTokens(ws_param)
  
  'データ検索用の設定
  apiMethod = "GET"
  apiUrl = "https://api.freee.co.jp/api/1/" & label
  apiParams = "?company_id=" & ws_param.Cells(6, 2).Value & "&limit=100" & _
    "&start_issue_date=" & TextBox1.Value & "&end_issue_date=" & TextBox2.Value
  apiHeaders.RemoveAll
  apiHeaders.Add "Authorization", "Bearer " & ws_param.Cells(1, 2).Value
  
  'ワークシートの設定&初期化
  Set ws_data = wb.Worksheets(label)
  ws_data.Rows("1:" & ws_data.Range("A" & ws_data.Rows.Count).End(xlUp).Row).Delete
  
   'データ出力(タイトル行)
  For cnt_col = 0 To UBound(keys)
    If cnt_col <= 11 Then '12項目以下は基本情報
      ws_data.Cells(1, cnt_col + 1).Value = keys(cnt_col)
    Else '13項目以降は明細情報
      ws_data.Cells(1, cnt_col + 1).Value = "dtl_" & keys(cnt_col)
    End If
  Next cnt_col
  
  'データ検索(1ページ目)
  Set apiJson = callRestApi(apiMethod, apiUrl, apiParams, apiHeaders)

  'データ出力(データ行:1ページ目)
  Call writeDealsDataValueAndIncrement(ws_data, apiJson, label, keys, cnt_res)

  'ページ数のカウント
  max_row = CLng(apiJson("meta")("total_count"))
  max_page = Application.RoundUp(max_row / 100, 0)

  '2ページ目以降の処理
  If max_row > 100 Then
    For cnt_page = 2 To max_page
      
      'トークン更新
      Call refreshTokens(ws_param)
  
      'データ検索用の設定(apiMethodとapiUrlは1ページ目と同じため割愛)
      apiParams = "?company_id=" & ws_param.Cells(6, 2).Value & "&limit=100" & _
        "&start_issue_date=" & TextBox1.Value & "&end_issue_date=" & TextBox2.Value & _
        "&offset=" & CStr((cnt_page - 1) * 100)
      apiHeaders.RemoveAll
      apiHeaders.Add "Authorization", "Bear " & ws_param.Cells(1, 2).Value
      
      'データ検索
      Set apiJson = callRestApi(apiMethod, apiUrl, apiParams, apiHeaders)
      
      'データ出力
      Call writeDealsDataValueAndIncrement(ws_data, apiJson, label, keys, cnt_res)
  
    Next cnt_page
  End If

End Sub

 

API実行に関するサブプロシージャから呼び出している関数

API実行に関するサブプロシージャから呼び出している関数(4点)のソースです。

  • refreshTokens()：
    • 前の記事の工程4で紹介した、二回目以降のアクセストークンの取得方法を使用している。
    • paramシートから必要な情報(Client ID等)を取得し、更新結果を同シートに反映している。
  • callRestApi()：前の記事の工程6でインポートしたJsonConverterのJson型変換関数を呼び出している。
  • writeDealsDataValueAndIncrement()：取引一覧は明細情報を保持するデータ形式となっているため、明細単位に出力する形としている。
Private Sub refreshTokens(ws_param As Worksheet)

  '変数宣言(API関連)
  Dim apiMethod As String
  Dim apiUrl As String
  Dim apiParams As String
  Dim apiHeaders As New Dictionary
  Dim apiJson As Object

  'アクセストークン取得用の設定
  apiMethod = "POST"
  apiUrl = "https://accounts.secure.freee.co.jp/public_api/token"
  apiParams = "?grant_type=refresh_token"
  apiParams = apiParams & "&redirect_uri=" & ws_param.Cells(3, 2).Value
  apiParams = apiParams & "&client_id=" & ws_param.Cells(4, 2).Value
  apiParams = apiParams & "&client_secret=" & ws_param.Cells(5, 2).Value
  apiParams = apiParams & "&refresh_token=" & ws_param.Cells(2, 2).Value
  apiHeaders.RemoveAll
  apiHeaders.Add "Content-Type", "application/x-www-form-urlencoded"
  
  'アクセストークン取得・出力
  Set apiJson = callRestApi(apiMethod, apiUrl, apiParams, apiHeaders)
  ws_param.Cells(1, 2).Value = apiJson("access_token")
  ws_param.Cells(2, 2).Value = apiJson("refresh_token")

End Sub


Private Function callRestApi(method As String, url As String, params As String, headers As Dictionary) As Object

  Dim http As Object
  Dim cnt As Long
  
  'httpリクエストオブジェクトの設定
  Set http = CreateObject("msxml2.xmlhttp") '参照設定でMicrosoft Scripting Runtimeが必要
  http.Open method, url & params, False
  
  'httpリクエストヘッダーの設定
  For cnt = 0 To headers.Count - 1
    http.setRequestHeader headers.keys(cnt), headers.items(cnt)
  Next cnt
  
  'リクエスト送信
  http.send
  
  'レスポンスの文字列をJsonに変換して返す
  Set callRestApi = JsonConverter.ParseJson(http.responseText)

End Function


Private Function concatString(apiJson As Object, label As String, key As String, cnt_row As Long, cnt_col As Long) As String

  Dim cnt_dtl As Long
  Dim tmp_dtl As String
  
  For cnt_dtl = 0 To apiJson(label)(cnt_row + 1)(key).Count() - 1
    If cnt_dtl > 0 Then
      tmp_dtl = tmp_dtl & ","
    Else
      tmp_dtl = ""
    End If
    tmp_dtl = tmp_dtl & apiJson(label)(cnt_row + 1)(key)(cnt_dtl + 1)
  Next cnt_dtl

  concatString = tmp_dtl

End Function


Private Sub writeDealsDataValueAndIncrement(ws_data As Worksheet, apiJson As Object, label As String, keys As Variant, cnt_res As Long)

  '変数宣言(処理変数)
  Dim cnt_row As Long 'apiJsonから取得するデータの行カウンタ
  Dim cnt_col As Long 'apiJsonから取得するデータの列カウンタ
  Dim cnt_dtl As Long 'apiJsonのdetails内の行カウンタ(複数明細考慮)

  For cnt_row = 0 To apiJson(label).Count - 1
    For cnt_col = 0 To UBound(keys)
      If cnt_col < 12 Then '12項目までは基本情報
        ws_data.Cells(cnt_res + 2, cnt_col + 1).Value = _
          apiJson(label)(cnt_row + 1)(keys(cnt_col))
      Else '13項目以降は明細情報
        For cnt_dtl = 0 To apiJson(label)(cnt_row + 1)("details").Count() - 1
          ws_data.Cells(cnt_res + 2, cnt_col + 1).Value = _
            apiJson(label)(cnt_row + 1)("details")(cnt_dtl + 1)(keys(cnt_col))
          '複数明細存在し明細が2行目以降の場合、前行の基本情報をコピペする
          If cnt_col = 12 And apiJson(label)(cnt_row + 1)("details").Count() > 1 And cnt_dtl > 0 Then
            ws_data.Range(ws_data.Cells(cnt_res + 1 + cnt_dtl, 1), _
              ws_data.Cells(cnt_res + 1 + cnt_dtl, 12)).Copy
            ws_data.Range(ws_data.Cells(cnt_res + 2 + cnt_dtl, 1), _
              ws_data.Cells(cnt_res + 2 + cnt_dtl, 12)).PasteSpecial
          End If
        Next cnt_dtl
      End If
    Next cnt_col
    cnt_res = cnt_res + apiJson(label)(cnt_row + 1)("details").Count()
  Next cnt_row

End Sub

 

データ結合に関するサブプロシージャ

メインプロシージャから呼び出しているSELECT文実行(データ結合)・出力に関するサブプロシージャのソースです。

  • APIから取得した各一覧データをデータベースのテーブルに見立て、ADOによるSELECT文の実行を行っている。
  • SELECT文の実行結果をSearchシートに出力する際、データの頭に’をつけて文字列扱いにしている(要否は用途や好みによる)。
Private Sub writeSearchData(wb As Workbook, sql As String)

  '定数宣言
  Const adOpenKeyset = 1 'CursorType:0=順方向,1=キーセット,2=動的,3=静的,-1=未指定
  Const adLockReadOnly = 1 'LockType:1=読取専用,2=レコード毎悲観的ロック,3=レコード毎楽観的ロック,4=楽観的バッチ更新
  
  '変数宣言(excel関連)
  Dim ws_data As Worksheet
  
  '変数宣言(SQL関連)
  Dim conn As Object
  Dim res As Object
  
  '変数宣言(処理変数)
  Dim cnt_row As Long
  Dim cnt_col As Long
  
  'ワークシートの設定&初期化
  Set ws_data = wb.Worksheets("Search")
  ws_data.Rows("1:" & ws_data.Range("A" & ws_data.Rows.Count).End(xlUp).Row).Delete
  
  'コネクションの設定
  Set conn = CreateObject("ADODB.Connection")
  conn.Provider = "Microsoft.ACE.OLEDB.12.0"
  conn.Properties("Extended Properties") = "Excel 12.0;HDR=YES;IMEX=1"
  
  'レコードセットの設定
  Set res = CreateObject("ADODB.Recordset")
  
  'コネクションオープン(接続先はこのExcelブック)
  conn.Open ThisWorkbook.FullName
  
  'レコードセット取得(SELECT文実行)
  res.Open sql, conn, adOpenKeyset, adLockReadOnly
  
  'データ出力
  For cnt_row = 0 To res.RecordCount - 1
    For cnt_col = 0 To res.Fields.Count - 1
      If cnt_row = 0 Then
        ws_data.Cells(cnt_row + 1, cnt_col + 1).Value = res(cnt_col).Name 'タイトル行
      End If
      ws_data.Cells(cnt_row + 2, cnt_col + 1) = "'" & res(cnt_col).Value 'データ
    Next cnt_col
    res.MoveNext
  Next cnt_row
  
  'レコードセットとコネクションのクローズ
  res.Close
  Set res = Nothing
  conn.Close
  Set conn = Nothing

End Sub

 

アクセストークン・リフレッシュトークンに関する補足事項

リフレッシュトークンの有効期限は発行後90日間、アクセストークンの有効期限は発行後6時間です。有効期限が切れた場合は(VBAソースの実装ミスや使用済アクセストークンの再利用を試みた等、何らかの原因で使用可能なアクセストークン・リフレッシュトークンをロストした場合も)、前の記事の工程3の開発アプリの設定画面の認証用URLから認可コードを再取得する必要があります。

 

おわりに

以前の記事でもExcel VBAで各種APIに接続する例(Microsoft Graph APIによるSharePointリストへの接続やe-Stat APIへの接続など)を紹介しましたが、今回のfreee APIはそれらよりも認証関連の扱いがやや複雑に感じられたかもしれません。
しかし、freee APIは開発者コミュニティに詳細な仕様説明やサンプルソースが豊富に掲載されていますので、本格的に活用したい場合は大いに役立つと思います。
今回紹介した例は、取引データとそれにかかわる一部マスターデータの取得だけでしたが、更新系の処理もAPIで実行できますので、興味があれば開発者コミュニティの情報をご覧ください。
※freee Developers Community：ホーム - freee Developers Community