コンテンツへスキップ

SuccessFactors の OData API を Excel マクロから操作する方法

（最終更新：2026年6月）

SuccessFactors のデータは、OData API を使うことでシステム外から参照・更新できます。

標準画面だけでは対応しづらい業務でも、OData API を活用すれば、内製アプリや Excel マクロから SuccessFactors のデータを操作できるようになります。たとえば、次のような用途に利用できます。

  • 従業員情報を任意の形式で参照する
  • 申請データを一括で更新する
  • 独自のワークフローと連携する
  • 別システムのデータを組み合わせて配布する

この記事では、Excel マクロを使って SuccessFactors の OData API を実行する方法を解説します。専用の開発環境を用意しなくても、Excel であれば API の動作確認がしやすく、取得したデータも表形式で確認できます。

OData API を使うと何が便利なのか

SuccessFactors のデータを一括編集する場合、通常は次のような手順になります。

  1. SuccessFactors にログインする
  2. 対象データのエクスポートジョブを実行する
  3. ジョブ完了後にCSV をダウンロードする
  4. CSV を指定フォーマットに合わせて加工する
  5. 加工済み CSV を SuccessFactors にインポートする
  6. インポートジョブの結果を確認する
  7. エラーがあれば修正して再実行する

この方法でもデータ更新はできますが、CSV の列順、必須項目、文字コード、日付形式などに注意が必要です。慣れていないと、インポートエラーの原因調査だけで時間がかかることもあります。

一方で、OData API を Excel マクロに組み込むと、操作をかなりシンプルにできます。たとえば、次のような流れにできます。

  1. Excel の「データ取得」ボタンをクリックすると、最新データが Excel 上に表示される
  2. Excel 上で内容を編集する
  3. 「データ登録」ボタンをクリックすると、更新した情報がSuccessFactorsに登録される

利用者から見ると、SuccessFactors へのログインや CSV のエクスポート・インポートを意識せず、Excel 上の操作だけでデータ更新が完結します。さらに、自動採番、入力チェック、差分判定などを組み合わせれば、実務で使える業務ツールとして活用できます。

認証方式について

SuccessFactors の API 認証方式として、これまで利用されてきた HTTP Basic 認証は、2026年11月に廃止される予定です。

現在は、SAP IAS に設定した OIDC アプリケーションを介してアクセストークンを取得し、そのトークンで SuccessFactors の OData API を実行する方式が推奨されています。この方式では、認証情報を直接扱う範囲を抑えながら、より安全に API 連携を構成できます。

API 実行ユーザーの考え方

SuccessFactors の API を誰の権限で実行するかには、大きく分けて次の2つの考え方があります。

Principal Propagation

Principal Propagation は、実際に操作している利用者本人の権限で API を実行する方式です。利用者ごとに参照・更新できるデータを制御したい場合に適しており、誰が何を操作したかも追跡しやすくなります。一方で、認証まわりの構成はやや複雑になります。

Technical User

Technical User は、API 連携用に用意した専用ユーザーの権限で API を実行する方式です。利用者に関係なく、同じ権限・同じ範囲でデータを取得・更新できればよい場合に向いています。設定や運用は比較的シンプルですが、専用ユーザーに広すぎる権限を付与しないよう注意が必要です。

この記事では、より実運用に近い構成として、Principal Propagation を使う方法を解説します。

全体の構築方法

構築は、大きく次の流れで進めます。

  1. IAS 側で OIDC アプリケーションを作成する
  2. SuccessFactors 側で OIDC OAuth クライアントアプリケーションを登録する
  3. VBA で HTTP リクエスト用の共通処理を作成する
  4. VBA でSuccessFactors のアクセストークンを取得する処理を作成する
  5. VBA で SuccessFactors のデータを取得する処理を作成する

IAS OIDCアプリケーションの設定

まず、SAP CIS 管理画面から IAS 側の OIDC アプリケーションを作成します。

  1. SAP CIS管理画面から、Application & ResourcesのApplicationを開く。
  2. 「Create」から新しいアプリをOpenID Connectタイプで作成する。
  3. OpenID Connect Configuration設定で、任意の名前を入力し、Grant Typeで「Token Exchange (RFC 8693)」にチェックを入れ、Access Token Formatに「JSON Web Token」を選択し、保存する。
  4. TrustのProvided APIs設定で、「Allow all APIs for principal propagation」にチェックを入れ、保存する。
  5. TrustのDependencies設定で、「Add」をクリックし、Dependency Nameに任意の値を入力し、ApplicationでSuccessFactorsを選択し、APIで「All APIs」を選択し、保存する。Dependency Nameは後で使うのでメモしておく。
  6. TrustのClient Authentication設定で、Secretsの「Add」をクリックし、API Accessで「Application」「Application Users」「OpenID」にチェックを入れ、保存する。表示されるClient IDとClient Secretは後で使うのでメモしておき、「OK」をクリックする。
  7. 社用パソコンでのみ実行可能にするためにはIPアドレス制限をかけます。Authentication and AccessのRisk-Based Authentication設定で、会社のIPアドレスレンジを「Alloｗ」に設定し、Default Authentication Ruleを「Deny」に設定します。

SuccessFactors OIDCアプリケーションの設定

次に、SuccessFactors 側で OIDC OAuth クライアントアプリケーションを登録します。

  1. SuccessFactorsのセキュリティセンター画面を開きます。
  2. 「OIDC OAuthクライアントアプリケーションの登録」をクリックする。
  3. 「アプリケーションタイプ」タブにて、「登録」をクリックし、任意のタイプ名を入力し、「登録」をクリックする。
  4. 「アプリケーションマップ」タブにて、「登録」をクリックし、任意のマップ名を入力し、メモしておいたClient IDを入力し、作成したアプリケーションタイプを選択し、「登録」をクリックする。

URL等の情報収集

VBA コードを書く前に、コードで使うURL等を収集しておきます。

  • SAP CIS/IASのURL（例：https://xxxxx.accounts.cloud.sap）
  • OIDCアプリケーション作成時にメモしたClient ID, Client Secret, Dependency Name
  • SuccessFactorsのAPIサーバーURL（ここに一覧があります）

ExcelマクロのVBAコード

収集した情報をもとに、定数を定義します。

' IAS
Private Const IAS_BASE_URL As String = ""
Private Const IAS_TOKEN_ENDPOINT As String = IAS_BASE_URL & "/oauth2/token"

' OIDC Client
Private Const OIDC_CLIENT_ID As String = ""
Private Const OIDC_CLIENT_SECRET As String = ""
Private Const OIDC_DEP_NAME As String = ""

' SuccessFactors
Private Const SF_API_BASE_URL As String = ""

HTTPリクエスト関数のモジュールはこんな感じです。

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Private Const HTTP_MAX_RETRIES As Long = 3
Private Const HTTP_RETRY_WAIT_MS As Long = 5000
Private Const HTTP_ERROR_RESPONSE_MAX_LEN As Long = 500


'========================
' Generic POST helper
'========================
Public Function HttpPostForm(ByVal url As String, ByVal body As String) As String
    HttpPostForm = HttpSend( _
        method:="POST", _
        url:=url, _
        body:=body, _
        authorization:=vbNullString, _
        contentType:="application/x-www-form-urlencoded; charset=UTF-8", _
        accept:="application/json")
End Function


'========================
' Generic GET JSON helper
'========================
Public Function HttpGetJson( _
    ByVal url As String, _
    Optional ByVal authorization As String = "") As String

    HttpGetJson = HttpSend( _
        method:="GET", _
        url:=url, _
        body:=vbNullString, _
        authorization:=authorization, _
        contentType:=vbNullString, _
        accept:="application/json")
End Function


'========================
' Generic GET XML helper
'========================
Public Function HttpGetXml( _
    ByVal url As String, _
    Optional ByVal authorization As String = "") As String

    HttpGetXml = HttpSend( _
        method:="GET", _
        url:=url, _
        body:=vbNullString, _
        authorization:=authorization, _
        contentType:=vbNullString, _
        accept:="application/atom+xml,application/xml")
End Function


'========================
' Generic HTTP sender
'========================
Private Function HttpSend( _
    ByVal method As String, _
    ByVal url As String, _
    ByVal body As String, _
    Optional ByVal authorization As String = "", _
    Optional ByVal contentType As String = "", _
    Optional ByVal accept As String = "application/json") As String
    
    Dim http As Object
    Dim attempt As Long
    Dim statusCode As Long
    Dim responseText As String
    Dim lastError As String

    For attempt = 1 To HTTP_MAX_RETRIES
        Set http = Nothing
        statusCode = 0
        responseText = vbNullString
        lastError = vbNullString

        On Error GoTo SendError

        Set http = CreateHttpRequest()
        http.Open method, url, False

        ApplyHeaders http, authorization, contentType, accept

        If UCase$(method) = "GET" Then
            http.Send
        Else
            http.Send body
        End If

        statusCode = CLng(http.Status)
        responseText = CStr(http.responseText)

        On Error GoTo 0
        If IsSuccessStatus(statusCode) Then
            HttpSend = responseText
            GoTo CleanExit
        End If

        lastError = BuildHttpErrorMessage(attempt, statusCode, responseText)

RetryNext:
        CloseHttpRequest http
        If attempt < HTTP_MAX_RETRIES Then
            Sleep HTTP_RETRY_WAIT_MS * attempt
        End If
    Next attempt

    Err.Raise vbObjectError + 1002, "HttpSend", _
        "HTTP " & method & " failed after retries: " & lastError
    Exit Function

SendError:
    lastError = "Attempt " & attempt & ": " & Err.number & " - " & Err.Description
    Err.Clear
    Resume RetryNext

CleanExit:
    CloseHttpRequest http
End Function

Private Function CreateHttpRequest() As Object
    Set CreateHttpRequest = CreateObject("MSXML2.XMLHTTP.6.0")
End Function

Private Sub ApplyHeaders( _
    ByVal http As Object, _
    ByVal authorization As String, _
    ByVal contentType As String, _
    ByVal accept As String)

    If Len(accept) > 0 Then
        http.setRequestHeader "Accept", accept
    End If

    If Len(authorization) > 0 Then
        http.setRequestHeader "Authorization", authorization
    End If

    If Len(contentType) > 0 Then
        http.setRequestHeader "Content-Type", contentType
    End If
End Sub

Private Function IsSuccessStatus(ByVal statusCode As Long) As Boolean
    IsSuccessStatus = (statusCode >= 200 And statusCode < 300)
End Function

Private Function BuildHttpErrorMessage( _
    ByVal attempt As Long, _
    ByVal statusCode As Long, _
    ByVal responseText As String) As String

    BuildHttpErrorMessage = "Attempt " & attempt & _
        ": HTTP " & statusCode & _
        ", Response=" & Left$(responseText, HTTP_ERROR_RESPONSE_MAX_LEN)
End Function

Private Sub CloseHttpRequest(ByRef http As Object)
    On Error Resume Next
    If Not http Is Nothing Then http.abort
    Set http = Nothing
    On Error GoTo 0
End Sub


'========================
' WinINet（XMLHTTP）はプロキシ検出/DNS/TLSのキャッシュがないと通信が失敗することがある
' 本命の通信をする前にダミーの通信を1回しておくと解消する
'========================
Public Sub WarmupNetwork(ByVal ias As String)
    Dim http As Object

    On Error GoTo EH

    Set http = CreateHttpRequest()
    http.Open "GET", ias & "/", False
    http.setRequestHeader "Cache-Control", "no-cache"
    http.Send

CleanExit:
    CloseHttpRequest http
    Exit Sub

EH:
    Debug.Print "Err.Number=" & Err.number
    Debug.Print "Err.Description=" & Err.Description
    Resume CleanExit
End Sub

SuccessFactorsのAPIトークンを取得するモジュールはこんな感じです。

Option Explicit

Private Const GRANT_TYPE_PASSWORD As String = "password"
Private Const GRANT_TYPE_JWT_BEARER As String = "urn:ietf:params:oauth:grant-type:jwt-bearer"
Private Const RESOURCE_PREFIX As String = "urn:sap:identity:application:provider:name:"

'========================
' Get SuccessFactors API access token by user password flow
'========================
Public Function GetSuccessFactorsAccessTokenByPasswordGrant( _
    ByVal tokenEndpoint As String, _
    ByVal clientId As String, _
    ByVal clientSecret As String, _
    ByVal userName As String, _
    ByVal password As String, _
    ByVal dependencyName As String) As String

    Dim idToken As String
    Dim accessToken As String

    idToken = GetIdToken(tokenEndpoint, clientId, clientSecret, userName, password)
    If Len(idToken) = 0 Then
        Err.Raise vbObjectError + 2001, _
            "GetSuccessFactorsAccessTokenByPasswordGrant", _
            "Failed to get id_token from IAS."
    End If

    accessToken = ExchangeIdTokenForApiAccessToken( _
        tokenEndpoint, clientId, clientSecret, idToken, dependencyName)

    If Len(accessToken) = 0 Then
        Err.Raise vbObjectError + 2002, _
            "GetSuccessFactorsAccessTokenByPasswordGrant", _
            "Failed to get SuccessFactors access_token."
    End If

    GetSuccessFactorsAccessTokenByPasswordGrant = accessToken
End Function

Private Function GetIdToken( _
    ByVal tokenEndpoint As String, _
    ByVal clientId As String, _
    ByVal clientSecret As String, _
    ByVal userName As String, _
    ByVal password As String) As String

    Dim body As String
    Dim responseText As String

    body = JoinFormFields( _
        "client_id", clientId, _
        "client_secret", clientSecret, _
        "grant_type", GRANT_TYPE_PASSWORD, _
        "username", userName, _
        "password", password, _
        "scope", "openid")

    responseText = HttpPostForm(tokenEndpoint, body)

    GetIdToken = ExtractJsonValue(responseText, "id_token")
End Function

Private Function ExchangeIdTokenForApiAccessToken( _
    ByVal tokenEndpoint As String, _
    ByVal clientId As String, _
    ByVal clientSecret As String, _
    ByVal idToken As String, _
    ByVal dependencyName As String) As String

    Dim body As String
    Dim responseText As String

    body = JoinFormFields( _
        "client_id", clientId, _
        "client_secret", clientSecret, _
        "grant_type", GRANT_TYPE_JWT_BEARER, _
        "assertion", idToken, _
        "resource", RESOURCE_PREFIX & dependencyName)

    responseText = HttpPostForm(tokenEndpoint, body)

    ExchangeIdTokenForApiAccessToken = ExtractJsonValue(responseText, "access_token")
End Function


'========================
' Helpers
'========================
Private Function JoinFormFields(ParamArray pairs() As Variant) As String
    Dim i As Long
    Dim parts() As String
    Dim partIndex As Long

    If (UBound(pairs) - LBound(pairs) + 1) Mod 2 <> 0 Then
        Err.Raise vbObjectError + 2003, "JoinFormFields", _
            "Form fields must be supplied as key/value pairs."
    End If

    ReDim parts(0 To ((UBound(pairs) - LBound(pairs) + 1) \ 2) - 1)

    partIndex = 0
    For i = LBound(pairs) To UBound(pairs) Step 2
        parts(partIndex) = UrlEncode(CStr(pairs(i))) & "=" & UrlEncode(CStr(pairs(i + 1)))
        partIndex = partIndex + 1
    Next i

    JoinFormFields = Join(parts, "&")
End Function

Private Function ExtractJsonValue(ByVal jsonText As String, ByVal keyName As String) As String
    Dim re As Object
    Dim matches As Object
    Dim pattern As String

    Set re = CreateObject("VBScript.RegExp")
    re.Global = False
    re.IgnoreCase = True

    pattern = """" & keyName & """" & "\s*:\s*""([^""]+)"""
    re.pattern = pattern

    If re.test(jsonText) Then
        Set matches = re.Execute(jsonText)
        ExtractJsonValue = CStr(matches(0).SubMatches(0))
    End If

End Function

SuccessFactorsからデータを取得するモジュールはこんな感じです。
サンプルとしてポジションデータを取得するコードにしています。
似たような構造で、SuccessFactorsにデータを登録することができます。

Option Explicit

Private Const ODATA_FORMAT_ATOM As String = "atom"
Private Const ODATA_ACTIVE_STATUS_FILTER As String = "status eq 'A'"
Private Const ODATA_EFFECTIVE_STATUS_FILTER As String = "effectiveStatus eq 'A'"
Private Const ODATA_AS_OF_DATE_PARAM As String = "asOfDate"

'========================' Column definitions'========================
Public Function GetPositionColumns() As Collection
    Dim cols As New Collection
    
    cols.Add CreateColumnDefinition("code", "ポジションID")
    cols.Add CreateColumnDefinition("externalName_defaultValue", "ポジション名")
    cols.Add CreateColumnDefinition("parentPosition/code", "親ポジションID")
    cols.Add CreateColumnDefinition("parentPosition/externalName_defaultValue", "親ポジション名")
    cols.Add CreateColumnDefinition("companyNav/externalCode", "会社CD")
    cols.Add CreateColumnDefinition("companyNav/name", "会社")
    cols.Add CreateColumnDefinition("departmentNav/externalCode", "部署CD")
    cols.Add CreateColumnDefinition("departmentNav/name", "部署")

    Set GetPositionColumns = cols
End Function

'========================' Public fetchers'========================
Public Function GetActivePositionData( _
    ByVal apiBaseUrl As String, _
    ByVal accessToken As String, _
    Optional ByVal companyCode As String = "") As Variant

    Dim columns As Collection
    Dim filterClause As String

    Set columns = GetPositionColumns()
    filterClause = AddCompanyFilter(ODATA_EFFECTIVE_STATUS_FILTER, "companyNav/externalCode", companyCode)

    GetActivePositionData = FetchEntityData( _
        apiBaseUrl:=apiBaseUrl, _
        accessToken:=accessToken, _
        entityName:="Position", _
        columns:=columns, _
        expandClause:="companyNav,departmentNav,jobCodeNav,parentPosition", _
        filterClause:=filterClause, _
        orderByClause:="code", _
        statusLabel:="ポジション情報を取得中...", _
        includeAsOfDate:=True)
End Function

'========================' URL construction'========================
Private Function FetchEntityData( _
    ByVal apiBaseUrl As String, _
    ByVal accessToken As String, _
    ByVal entityName As String, _
    ByVal columns As Collection, _
    ByVal expandClause As String, _
    ByVal filterClause As String, _
    ByVal orderByClause As String, _
    ByVal statusLabel As String, _
    Optional ByVal includeAsOfDate As Boolean = False) As Variant

    FetchEntityData = FetchPagedEntityData( _
        initialUrl:=BuildEntityUrl( _
            apiBaseUrl:=apiBaseUrl, _
            entityName:=entityName, _
            columns:=columns, _
            expandClause:=expandClause, _
            filterClause:=filterClause, _
            orderByClause:=orderByClause, _
            includeAsOfDate:=includeAsOfDate), _
        accessToken:=accessToken, _
        columns:=columns, _
        statusLabel:=statusLabel)
End Function

Private Function BuildEntityUrl( _
    ByVal apiBaseUrl As String, _
    ByVal entityName As String, _
    ByVal columns As Collection, _
    ByVal expandClause As String, _
    ByVal filterClause As String, _
    ByVal orderByClause As String, _
    Optional ByVal includeAsOfDate As Boolean = False) As String

    Dim url As String

    url = apiBaseUrl & "/odata/v2/" & entityName & "?$format=" & ODATA_FORMAT_ATOM

    If Len(expandClause) > 0 Then
        url = url & "&$expand=" & expandClause
    End If

    If includeAsOfDate Then
        url = url & "&" & ODATA_AS_OF_DATE_PARAM & "=" & Format$(Date, "yyyy-mm-dd")
    End If

    url = url & "&$select=" & BuildSelectClause(columns)

    If Len(filterClause) > 0 Then
        url = url & "&$filter=" & UrlEncode(filterClause)
    End If

    If Len(orderByClause) > 0 Then
        url = url & "&$orderby=" & orderByClause
    End If

    BuildEntityUrl = url
End Function

Private Function AddCompanyFilter( _
    ByVal filterClause As String, _
    ByVal companyFieldName As String, _
    ByVal companyCode As String) As String

    If Len(companyCode) > 0 Then
        AddCompanyFilter = filterClause & " and " & companyFieldName & " eq '" & companyCode & "'"
    Else
        AddCompanyFilter = filterClause
    End If
End Function

Private Function BuildSelectClause(ByVal columns As Collection) As String
    Dim parts() As String
    Dim i As Long

    ReDim parts(1 To columns.Count)

    For i = 1 To columns.Count
        parts(i) = CStr(columns(i)("FieldName"))
    Next i

    BuildSelectClause = Join(parts, ",")
End Function

'========================' Paged Atom XML fetch/parse'========================
Private Function FetchPagedEntityData( _
    ByVal initialUrl As String, _
    ByVal accessToken As String, _
    ByVal columns As Collection, _
    ByVal statusLabel As String) As Variant

    Dim nextUrl As String
    Dim xmlText As String
    Dim records As Collection

    Set records = New Collection
    nextUrl = initialUrl

    Do While Len(nextUrl) > 0
        xmlText = HttpGetXml( _
            url:=nextUrl, _
            authorization:="Bearer " & accessToken)

        AppendRecordsFromFeedXml xmlText, records, columns
        nextUrl = GetNextLinkFromFeed(xmlText)
    Loop

    FetchPagedEntityData = CollectionToArray(records, columns)
End Function

Private Sub AppendRecordsFromFeedXml( _
    ByVal xmlText As String, _
    ByRef records As Collection, _
    ByVal columns As Collection)

    Dim doc As Object
    Dim entries As Object
    Dim entry As Object
    Dim record As Object
    Dim i As Long
    Dim j As Long

    Set doc = CreateAtomXmlDocument(xmlText, True)
    Set entries = doc.SelectNodes("/a:feed/a:entry")

    If entries.Length = 0 Then Exit Sub

    For i = 0 To entries.Length - 1
        Set entry = entries.Item(i)
        Set record = CreateObject("Scripting.Dictionary")

        For j = 1 To columns.Count
            record(columns(j)("FieldName")) = GetXmlFieldText(entry, CStr(columns(j)("FieldName")))
        Next j

        records.Add record
    Next i
End Sub

Private Function GetXmlFieldText( _
    ByVal entryNode As Object, _
    ByVal fieldPath As String) As String

    Dim parts() As String
    Dim currentEntry As Object
    Dim props As Object
    Dim linkNode As Object
    Dim inlineEntry As Object
    Dim node As Object
    Dim nullAttr As Object
    Dim i As Long
    Dim lastIndex As Long

    If entryNode Is Nothing Then Exit Function
    If Len(fieldPath) = 0 Then Exit Function

    parts = Split(fieldPath, "/")
    lastIndex = UBound(parts)
    Set currentEntry = entryNode

    For i = LBound(parts) To lastIndex - 1
        Set linkNode = currentEntry.SelectSingleNode("a:link[@title='" & parts(i) & "']")
        If linkNode Is Nothing Then Exit Function

        Set inlineEntry = linkNode.SelectSingleNode("m:inline/a:entry")
        If inlineEntry Is Nothing Then Exit Function

        Set currentEntry = inlineEntry
    Next i

    Set props = currentEntry.SelectSingleNode("a:content/m:properties")
    If props Is Nothing Then Exit Function

    Set node = props.SelectSingleNode("d:" & parts(lastIndex))
    If node Is Nothing Then Exit Function

    Set nullAttr = node.Attributes.getNamedItem("m:null")
    If Not nullAttr Is Nothing Then
        If LCase$(nullAttr.text) = "true" Then Exit Function
    End If

    GetXmlFieldText = node.text
End Function

Private Function GetNextLinkFromFeed(ByVal xmlText As String) As Strin
    gDim doc As Object
    Dim node As Object
    Dim hrefAttr As Object

    Set doc = CreateAtomXmlDocument(xmlText, False)
    If doc Is Nothing Then Exit Function

    Set node = doc.SelectSingleNode("/a:feed/a:link[@rel='next']")
    If node Is Nothing Then Exit Function

    Set hrefAttr = node.Attributes.getNamedItem("href")
    If Not hrefAttr Is Nothing Then
        GetNextLinkFromFeed = hrefAttr.text
    End If
End Function

Private Function CreateAtomXmlDocument( _
    ByVal xmlText As String, _
    ByVal raiseOnParseError As Boolean) As Object

    Dim doc As Object

    Set doc = CreateObject("MSXML2.DOMDocument.6.0")
    doc.async = False
    doc.validateOnParse = False

    If Not doc.LoadXML(xmlText) Then
        If raiseOnParseError Then
            Err.Raise vbObjectError + 1201, "CreateAtomXmlDocument", _
                "Failed to parse XML response."
        End If
        Exit Function
    End If

    doc.SetProperty "SelectionLanguage", "XPath"
    doc.SetProperty "SelectionNamespaces", _
        "xmlns:a='http://www.w3.org/2005/Atom' " & _
        "xmlns:m='http://schemas.microsoft.com/ado/2007/08/dataservices/metadata' " & _
        "xmlns:d='http://schemas.microsoft.com/ado/2007/08/dataservices'"

    Set CreateAtomXmlDocument = doc
End Function

Private Function CollectionToArray( _
    ByVal records As Collection, _
    ByVal columns As Collection) As Variant

    Dim data() As Variant
    Dim rowIndex As Long
    Dim colIndex As Long
    Dim record As Object
    Dim fieldName As String

    If records.Count = 0 Or columns.Count = 0 Then
        CollectionToArray = Empty
        Exit Function
    End If

    ReDim data(1 To records.Count, 1 To columns.Count)

    For rowIndex = 1 To records.Count
        Set record = records(rowIndex)

        For colIndex = 1 To columns.Count
            fieldName = CStr(columns(colIndex)("FieldName"))
            data(rowIndex, colIndex) = record(fieldName)
        Next colIndex
    Next rowIndex

    CollectionToArray = data
End Function

上記のモジュールの準備ができれば、あとはGetSuccessFactorsAcessTokenとGetActivePositionDataを順番に呼び出すだけです。取得したデータは2次元配列になっているので、簡単にシートに書き出すことができます。