2017.11.15

セールスフォース

Salesforce技術ブログ：Excel VBA でカスタム表示ラベルの一覧を取得する

はじめまして。ドン高野と申します。まだ Salesforce を初めて１年ぐらいですが、絶賛 Salesforce API を勉強中です。
という事で今回は、Excel VBA を使ってカスタム表示ラベルの一覧を出力してみたいと思います。
※最近関わったプロジェクトでカスタム表示ラベル（多言語）を1000個以上使っており、こんなツールがあればなぁと思っていました。

早速調べてみましたが、カスタム表示ラベルを直接取得する API は見当たらず、仕方なくメタデータから引っこ抜く事にしました。処理の流れは以下の様になります。

　1. ログイン
　2. メタデータ（カスタム表示ラベル）取得
　3. メタデータの展開
　4. カスタム表示ラベル取得情報の読み込み
　5. カスタム表示ラベル情報を出力

０．はじめに

VBA の参照設定について

今回のマクロは Excel2016 で作成し、処理の中で以下のライブラリを使用しました。Windows標準のライブラリなのでどのバージョンでも動作すると思います。
VBAエディタメニュー＞ツール＞参照設定

　・Microsoft Scripting Runtime
　・Microsoft XML vX.0
　・Microsoft Shell Controls And Automation

API の呼び出しについて

処理に入る前に、処理の中で何度か API を呼び出しますので、API 呼び出し用の部品を作っておきます。
呼び出しは HTTP通信で行います。ヘッダ情報は以下の通り。

soapaction: ""
Content-Type: text/xml;charset=UTF-8

これを踏まえて、API 呼び出し用の部品を作っておきます。

' ****
' * HTTP 通信処理
' *
' * amUrl: URL
' * amSendXml: 送信する XML 文字列
' * aoResponseXml: 受け取った XML (OUTPUT)
' * return: True: 成功／False: 失敗
' ****
Private Function pbRequestHttp( _
    ByVal amUrl As String, _
    ByVal amSendXml As String, _
    ByRef aoResponseXml As MSXML2.DOMDocument _
) As Boolean
    Dim doHttp  As New MSXML2.XMLHTTP

    pbRequestHttp = False

    doHttp.Open "post", amUrl, False
    doHttp.setRequestHeader "Content-Type", "text/xml;charset=UTF-8"
    doHttp.setRequestHeader "SOAPAction", """"""
    doHttp.send amSendXml

    If doHttp.Status <> 200 Then Exit Function

    Set aoResponseXml = doHttp.responseXML
    pbRequestHttp = True

End Function

１．ログイン

まず、Salesforce にログインし、セッション情報を取得する必要があります。
パラメータには以下の XML を設定します。

<?xml version="1.0" encoding="utf-8"?>
<env:Envelope   >
  <env:Body>
    <n1:login >
      <n1:username>#username#</n1:username>
      <n1:password>#password#</n1:password>
    </n1:login>
  </env:Body>
</env:Envelope>

ログインに成功すると、以下のようなレスポンスが返ってきます。

<soapenv:Envelope   >
  <soapenv:Body>
    <loginResponse>
      <result>
        <metadataServerUrl>https://**********</metadataServerUrl>
        <passwordExpired>false</passwordExpired>
        <sandbox>false</sandbox>
        <serverUrl>https://**********</serverUrl>
        <sessionId>**********</sessionId>
        <userId>**********</userId>
        <userInfo>...</userInfo>
      </result>
    </loginResponse>
  </soapenv:Body>
</soapenv:Envelope>

レスポンスから sessionId, metadataServerUrl を取得し、次の処理を行います。
VBA ソースは以下の通り。

    Dim dmXml   As String
    Dim doXml   As MSXML2.DOMDocument

    ' **** ログイン処理 ****
    ' ログイン用 XML 作成
    dmXml = Constants.XML_LOGIN
    dmXml = Replace(dmXml, "#username#", "**********")
    dmXml = Replace(dmXml, "#password#", "**********")

    ' ログイン URL
    ' ※ SandBox の場合は、https://test.salesforce.com/services/Soap/u/41.0
    Dim dmLoginUrl  As String
    dmLoginUrl = "https://login.salesforce.com/services/Soap/u/41.0"

    ' ログイン
    If Not pbRequestHttp(dmLoginUrl, dmXml, doXml) Then Exit Sub

    ' セッションID、MetadataApi 用 URL を取得
    Dim dmSessionId As String
    Dim dmMetadataServerUrl As String
    dmSessionId = doXml.getElementsByTagName("sessionId").Item(0).Text
    dmMetadataServerUrl = doXml.getElementsByTagName("metadataServerUrl").Item(0).Text

２．メタデータ（カスタム表示ラベル）取得

次にカスタム表示ラベルを含むメタデータを取得します。メタデータ API の retrieve() をコールします。
パラメータには以下の XML を設定します。

<?xml version="1.0" encoding="utf-8"?>
<soap:Envelope   >
  <soap:Header>
    <SessionHeader >
      <sessionId>#sessionId#</sessionId>
    </SessionHeader>
  </soap:Header>
  <soap:Body>
    <retrieve >
      <retrieveRequest>
        <apiVersion>41.0</apiVersion>
        <singlePackage>true</singlePackage>
        <unpackaged>
          <version>41.0</version>
          <types>
            <name>CustomLabels</name>
            <members>*</members>
          </types>
          <types>
            <name>Translations</name>
            <members>*</members>
          </types>
        </unpackaged>
      </retrieveRequest>
    </retrieve>
  </soap:Body>
</soap:Envelope>

今回はカスタム表示ラベルとその翻訳情報を取得するので types に CustomLabels, Translations を指定していますが、この types に指定する内容によって、Apex コードやオブジェクト、プロファイル情報等、さまざまなメタデータを取得することができます。
コール後、以下のようなレスポンスが返ってきます。

<?xml version="1.0"?>
<soapenv:Envelope  >
  <soapenv:Body>
    <retrieveResponse>
      <result>
        <done>false</done>
        <id>**********</id>
        <state>Queued</state>
      </result>
    </retrieveResponse>
  </soapenv:Body>
</soapenv:Envelope>

メタデータ取得の処理は時間が掛かる事があるため、非同期で実行されます。retrieve() コール時に salesforce 側で処理が開始され、id が返ってきます。この id を元に、処理状況を確認する API checkRetrieveStatus() を定期的にコールし、処理が完了したかを確認します。
checkRetrieveStatus() のコールには以下の XML を設定します。

<?xml version="1.0" encoding="utf-8"?>
<soap:Envelope   >
  <soap:Header>
    <SessionHeader >
      <sessionId>#sessionId#</sessionId>
    </SessionHeader>
  </soap:Header>
  <soap:Body>
    <checkRetrieveStatus >
      <id>#id#</id>
    </checkRetrieveStatus>
  </soap:Body>
</soap:Envelope>

処理が完了すると、以下のようなレスポンスが返ってきます。

<soapenv:Envelope  >
  <soapenv:Body>
    <checkRetrieveStatusResponse>
      <result>
        <done>true</done>
        <id>**********</id>
        <status>Succeeded</status>
        <success>true</success>
        <zipFile>****************************************</zipFile>
        …
      </result>
    </checkRetrieveStatusResponse>
  </soapenv:Body>
</soapenv:Envelope>

done の値を確認し、true であれば処理完了です。false の場合はまだ処理中ですので、再度 checkRetrieveStatus() をコールし、処理が完了するまで繰り返します。success の値を確認し、処理が成功 (true) したかを判断します。処理が成功した場合、メタデータが ZIP ファイル（base64 エンコード）で返されます。次はこの zipFile の値を処理します。
ここまでの VBA ソースは以下の通り。

    ' **** メタデータ（カスタム表示ラベル）取得処理 ****
    ' メタデータ取得用 XML 作成
    dmXml = Constants.XML_CUSTOM_LABELS
    dmXml = Replace(dmXml, "#sessionId#", dmSessionId)

    ' メタデータ取得 API 呼び出し（非同期）
    If Not pbRequestHttp(dmMetadataServerUrl, dmXml, doXml) Then Exit Sub

    ' API コールの ID を取得
    Dim dmId    As String
    dmId = doXml.getElementsByTagName("id").Item(0).Text

    ' メタデータ取得 API 状況確認用 XML 作成
    dmXml = Constants.XML_CHECK_RETRIEVE_STATUS
    dmXml = Replace(dmXml, "#sessionId#", dmSessionId)
    dmXml = Replace(dmXml, "#id#", dmId)
    
    ' メタデータ取得 API 状況確認
    Dim dbDone  As Boolean
    Do
        Sleep 1000
        If Not pbRequestHttp(dmMetadataServerUrl, dmXml, doXml) Then Exit Sub
    
        ' done 項目が True で完了
        dbDone = CBool(doXml.getElementsByTagName("done").Item(0).Text)
    Loop Until dbDone

    ' メタデータ取得 API 結果確認
    Dim dbSuccess   As Boolean
    dbSuccess = CBool(doXml.getElementsByTagName("success").Item(0).Text)
    If Not dbSuccess Then Exit Sub

    ' メタデータ取得（ZIP ファイル base64 エンコード）
    Dim dmZipData   As String
    dmZipData = doXml.getElementsByTagName("zipFile").Item(0).Text

※ Do Loop 内で “Sleep 1000” とありますが、これは WindowsApi を使用しています。（１秒待機）
モジュール冒頭で以下を定義しています。

   Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal alMsec As LongPtr)

３．メタデータの展開

次は取得した ZIP ファイル（base64 エンコード）を処理し、メタデータのファイルを取り出します。
VBA での base64 のデコード処理はこんな感じです。

' ****
' * base64 デコード処理
' *
' * amString: base64 エンコード文字列
' * return: デコードデータ（バイナリ）
' ****
Private Function pbDecodeBase64(ByVal amString As String) As Byte()

    Dim doXmlDoc As Object
    Dim doElm As Object

    Set doXmlDoc = CreateObject("MSXML2.DOMDocument")

    ' base64 to byte array
    Set doElm = doXmlDoc.createElement("b64")
    doElm.DataType = "bin.base64"
    doElm.Text = amString

    pbDecodeBase64 = doElm.nodeTypedValue

End Function

デコード後は、ファイルに出力⇒解凍の流れとなります。ZIP ファイルの解凍は Shell32 ライブラリを使って行います。ここまでの処理を踏まえて、ZIP ファイルの解凍処理は以下のようになります。

' ****
' * ZIP ファイル解凍処理
' *
' * amZipData: ZIP ファイルデータ（base64 エンコード文字列）
' * amUnzipRootFolder: ZIP ファイル解凍先フォルダ (OUTPUT)
' ****
Private Sub pUnzipData(ByVal amZipData As String, ByRef amUnzipRootFolder As String)

    ' base64 デコード
    Dim dvZipBin()  As Byte
    dvZipBin = pbDecodeBase64(amZipData)

    ' 出力する ZIP ファイルのパスを作成（テンポラリフォルダに作成）
    Dim doFso   As New Scripting.FileSystemObject
    Dim doTempFolder    As Scripting.Folder
    Dim dmZipFile   As String
    Set doTempFolder = doFso.GetSpecialFolder(TemporaryFolder)
    Do
        dmZipFile = doFso.BuildPath(doTempFolder.Path, doFso.GetTempName()) & ".zip"
    Loop While doFso.FileExists(dmZipFile)

    ' ZIP ファイルを出力
    Dim diFileNo    As Integer
    diFileNo = FreeFile()
    Open dmZipFile For Binary As #diFileNo
    Dim i   As Long
    For i = 0 To UBound(dvZipBin)
        Put #diFileNo, , dvZipBin(i)
    Next i
    Close #diFileNo

    ' ZIP ファイル解凍先フォルダの作成（テンポラリフォルダに作成）
    Do
        amUnzipRootFolder = doFso.BuildPath(doTempFolder.Path, doFso.GetTempName())
    Loop While doFso.FolderExists(amUnzipRootFolder)
    doFso.CreateFolder amUnzipRootFolder

    ' ZIP ファイル解凍
    Dim doShell As New Shell32.Shell
    Dim doZip   As Shell32.Folder
    Set doZip = doShell.Namespace(dmZipFile)
    Dim doUnzipFolder   As Shell32.Folder
    Set doUnzipFolder = doShell.Namespace(amUnzipRootFolder)
    doUnzipFolder.CopyHere doZip.Items

    ' ZIP ファイルを削除
    doFso.DeleteFile dmZipFile

End Sub

メイン処理

    ' **** メタデータの展開 ****
    'ZIP ファイルを解凍
    Dim dmUnzipRootFolder   As String
    pUnzipData dmZipData, dmUnzipRootFolder

４．カスタム表示ラベル取得情報の読み込み

ここまで来ればあとは、メタデータを読み取って Excel に出力するだけです。
試しに以下のカスタム表示ラベルを作成してみました。

ZIP ファイルを解凍したメタデータは以下の構成になっています。

フォルダ構成

|-- labels
|   +-- CustomLabels.labels
|-- translations
|   +-- en_US.translation
+-- package.xml

※今回は翻訳設定が英語のみなので translation は en_US のみですが、
複数言語を設定している場合、言語分ファイルが作成されます。

CustomLabels.labels

<?xml version="1.0" encoding="UTF-8"?>
<CustomLabels >
    <labels>
        <fullName>LBL_APPLE</fullName>
        <categories>果物</categories>
        <language>ja</language>
        <protected>true</protected>
        <shortDescription>説明１</shortDescription>
        <value>りんご</value>
    </labels>
    <labels>
        <fullName>LBL_CHERRY</fullName>
        <categories>果物</categories>
        <language>ja</language>
        <protected>true</protected>
        <shortDescription>説明３</shortDescription>
        <value>さくらんぼ</value>
    </labels>
    <labels>
        <fullName>LBL_MELON</fullName>
        <categories>果物</categories>
        <language>ja</language>
        <protected>true</protected>
        <shortDescription>説明２</shortDescription>
        <value>メロン</value>
    </labels>
</CustomLabels>

en_US.translation

<?xml version="1.0" encoding="UTF-8"?>
<Translations >
    <customLabels>
        <label>Apple</label>
        <name>LBL_APPLE</name>
    </customLabels>
    <customLabels>
        <label>Cherry</label>
        <name>LBL_CHERRY</name>
    </customLabels>
    <customLabels>
        <label>Melon</label>
        <name>LBL_MELON</name>
    </customLabels>
</Translations>

VBA はこんな感じで組みました。

    ' **** カスタム表示ラベル取得情報の読み込み ****
    ' トランスレーション（翻訳）情報の読み込み
    Dim doFso   As New Scripting.FileSystemObject
    Dim doFile  As Scripting.File
    Dim dcTranslations  As New Scripting.Dictionary

    If doFso.FolderExists(dmUnzipRootFolder & "translations") Then
        ' translations フォルダ配下のファイルを読み込み
        For Each doFile In doFso.GetFolder(dmUnzipRootFolder & "translations").Files
            doXml.Load doFile.Path
        
            Dim doNode  As MSXML2.IXMLDOMNode
            Dim dmTranslation   As String
            dmTranslation = doFso.GetFileName(doXml.Url)
            For Each doNode In doXml.getElementsByTagName("customLabels")
                Dim dmName  As String
                Dim dmLabel As String
                dmName = doNode.SelectSingleNode("name").Text
                dmLabel = doNode.SelectSingleNode("label").Text
            
                If dmLabel <> "" Then
                    If Not dcTranslations.Exists(dmName) Then dcTranslations.Add dmName, New Scripting.Dictionary
                    dcTranslations(dmName)(dmTranslation) = dmLabel
                End If
            Next doNode
        
        Next doFile
    End If

    ' カスタム表示ラベル情報の読み込み
    Dim dcRecords   As New Collection
    Dim dcRecord    As Scripting.Dictionary
    Dim dcFieldInfo As Scripting.Dictionary
    Dim doField As MSXML2.IXMLDOMNode
    Dim dvKey   As Variant

    Set dcFieldInfo = New Scripting.Dictionary
    
    ' CustomLabels.labels の読み込み
    doXml.Load dmUnzipRootFolder & "labelsCustomLabels.labels"

    For Each doNode In doXml.getElementsByTagName("labels")
        Set dcRecord = New Scripting.Dictionary
        For Each doField In doNode.ChildNodes
            dcRecord.Add doField.nodeName, doField.Text
        Next doField

        If dcTranslations.Exists(dcRecord("fullName")) Then
            For Each dvKey In dcTranslations(dcRecord("fullName")).Keys
                dcRecord.Add dvKey, dcTranslations(dcRecord("fullName"))(dvKey)
            Next dvKey
        End If
        
        dcRecords.Add dcRecord
    Next doNode

    ' メタデータの削除
    doFso.DeleteFolder dmUnzipRootFolder

５．カスタム表示ラベル情報を出力

Excel シートに出力します。VBA はこんな感じです。

    ' **** カスタム表示ラベル情報を出力 ****
    Dim doRange As Excel.Range
    Dim doCell  As Excel.Range
    Dim dvRange As Variant
    Dim i   As Long
    Dim j   As Long
    Set doCell = Application.ActiveCell
    Set doRange = Application.Range(doCell, doCell.Offset(dcRecords.Count, dcRecords(1).Count - 1))
    dvRange = doRange

    ' 表ヘッダ行を設定
    Set dcRecord = dcRecords(1)
    For i = 0 To dcRecords(1).Count - 1
        dvRange(1, i + 1) = dcRecord.Keys(i)
    Next i

    ' カスタム表示ラベル情報を設定
    For i = 1 To dcRecords.Count
        Set dcRecord = dcRecords(i)
        For j = 1 To dcRecords(1).Count
            dvRange(i + 1, j) = dcRecord(dvRange(1, j))
        Next j
    Next i

    ' シートに出力
    doRange = dvRange

できました！