Salesforce技術ブログ：Excel VBA でカスタム表示ラベルの一覧を取得する
こんにちは！
今回は、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
できました！ 
という事で今回はカスタム表示ラベルを出力させる事ができました。 次は、オブジェクト定義の出力や Excel 上でのデータの更新・削除にチャレンジしたいと思います。
