LoginSignup
1
0

More than 1 year has passed since last update.

@tosisisijp(tosisisi)

WinActorのVBScriptで OAuth 認証を使って Salesforce APIにアクセスするサンプルプログラムを書いてみた。

Last updated at Posted at 2022-03-22

背景

WinActorでSalesforce使おうと思ったら、スマホの認証が挟まったりして、全然自動化できない状態でした。
OAuth認証＋APIアクセスを行うと Salesforceの多要素認証(MFA)化に対応できるかもと思い、
WinActorのVBScriptで OAuth 認証を使って Salesforce APIにアクセスするサンプルプログラムを書いてみました。
WinActorのスクリプトに貼り付けてみてください。

環境設定もなかなか大変ですが、
これが出来ると突破口になるかもです。
質問などいただいたら随時更新しようと思います。

前提条件

１．もし試行的に実行したいのであれば、

Salesforce Lightning Platform Developer Edition に登録すると良いです。
https://developer.salesforce.com/signup
※通常の試用版だとAPIアクセスが制限されててエラーしか出ませんでした・・・

２．Salesforce上で接続アプリケーションの作成を行う必要があります。

　image.png
　image.png
　image.png
　image.png

３．Salesforce上で作成したアプリケーションから、コンシューマ鍵、コンシューマの秘密を取得する必要があります。

　image.png
　上記画面で作成した接続アプリケーションの右側のドロップダウンから「参照」を選択
　image.png
　image.png
　image.png

４．Salesforce上で私のセキュリティートークンのリセットをし、受信したメールにあるセキュリティートークン文字列が必要となります。

　image.png
　image.png
　下記の様なメールに記載された文字列です。
　image.png
　image.png
　image.png

サンプルコード WinActor用 VBScript

WinActorのスクリプトノードに貼り付けて、各引数を設定してください。

Dim endpoint : endpoint = !endpoint!
Dim client_id : client_id = !client_id!
Dim client_secret : client_secret = !client_secret!
Dim username : username = !username!
Dim password : password = !password!
Dim secretToken : secretToken = !secretToken!

Dim access_token : access_token = $access_token$
Dim template_file : template_file = !テンプレートCSV!
Dim where : where = !データ絞込条件!
Dim limit : limit = !データ取得上限数!
Dim output_file : output_file = !出力先CSV!
Dim scenario_folder : scenario_folder = !シナリオフォルダ名!

Dim c
Set c = New SalesforceRestJsonController
c.Initialize endpoint
c.GetAccessToken client_id, client_secret, username, password, secretToken

c.CreateTemplateFiles scenario_folder

c.SaveJsonRecordsToCsv template_file, where, limit, output_file

Class SalesforceRestJsonController
	Public TemplateFile
	Public SObjectName
	Public FieldsCSV
	Public LabelsCSV
	Public Fields
	Public EndPoint
	Public AccessToken
	Public URL
	Public JsonObject
	Public JsonObjectEx
	Public TotalSize
	Public JsonTool
	
	Sub Class_Initialize
	End Sub

	Sub Initialize(pEndPoint)
		EndPoint = pEndPoint
	End Sub

	Function GetAccessToken(pClientId, pClientSecret, pUserName, pPassword, pSecretToken)
		Dim url : url = "/services/oauth2/token"

		Dim param
		param = "grant_type=password" _
			& "&client_id=" & pClientId _
			& "&client_secret=" & pClientSecret _
			& "&username=" & pUserName _
			& "&password=" & pPassword & pSecretToken
		Set jo = GetJsonObject(GetHttpResonseTextByPost(url, param))
		
		Me.AccessToken = jo.access_token
		GetAccessToken = Me.AccessToken
	End Function
	
	Function GetHttpResonseTextByPost(pUrl, pParam)
		Dim oHTTP : Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
		oHTTP.Open "POST", Me.EndPoint & pUrl, False
		oHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
		oHTTP.Send pParam
		GetHttpResonseTextByPost = oHTTP.ResponseText
		Set oHTTP = Nothing
	End Function

	Function GetHttpResonseTextByGet(pUrl)
		Dim oHTTP : Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
		oHTTP.Open "GET", EndPoint & pUrl, False
		oHTTP.SetRequestHeader "Content-Type", "application/json"
		oHTTP.SetRequestHeader "Authorization", "Bearer " & Me.AccessToken
		oHTTP.Send()
		GetHttpResonseTextByGet = oHTTP.ResponseText
		Set oHTTP = Nothing
	End Function

	Function GetJsonObject(pJsonString)
		Set Me.JsonTool = CreateObject("HtmlFile")
		Me.JsonTool.write "<meta http-equiv='X-UA-Compatible' content='IE=edge' />"
		Me.JsonTool.write "<script>document.getJSArray=function () {return eval('[]');}</script>"
		Me.JsonTool.write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
		Me.JsonTool.write "<script>document.JsonStringify=JSON.stringify;</script>"
		Set Me.JsonObject = Me.JsonTool.JsonParse(pJsonString)
		Set GetJsonObject = Me.JsonObject
	End Function

	Function SaveJsonRecordsToCsv(pTemplateFile, pWhere, pLimit, pOutputFile)
		SetupQueryUrl pTemplateFile, pWhere, pLimit
		Dim oHTTP
		Set oHTTP = GetHttpObjectFromUrlAsync(Me.URL)

		If oHTTP.readyState <> 4 Then
    			oHTTP.waitForResponse(600)
		End If

		WriteCsvHeader pOutputfile

		Dim json
		json = oHTTP.ResponseText
		Set oHTTP = Nothing
		AppendJsonRecordsToCsvAsync pOutputFile, json
	End Function

	Function SetupQueryUrl(pTemplateFile, pWhere, pLimit)
		Me.TemplateFile = pTemplateFile
		Set objRe = New RegExp
		objRe.Pattern = "(.+\\)+(.+)_template_(.+)\.csv$"
		Set matches = objRe.Execute(TemplateFile)
		Me.SObjectName = matches(0).SubMatches(2)

		Dim stream : Set stream = GetAdodbStreamForUTF8()
		stream.Open
		stream.LoadFromFile Me.TemplateFile
		Me.LabelsCSV = stream.ReadText(-2)
		Me.FieldsCSV = stream.ReadText(-2)
		stream.Close
		
		Me.Fields = Split(FieldsCSV, ",")

		Me.URL = "/services/data/v53.0/query/?q=SELECT " & FieldsCSV & " FROM " & SObjectName
		If pWhere <> "" Then
			Me.URL = Me.URL & " WHERE " & pWhere
		End If
		If pLimit <> "" Then
			Me.URL = Me.URL & " LIMIT " & pLimit
		End If
	End Function

	Function WriteCsvHeader(pOutputfile)
		Dim stream
		Set stream = GetAdodbStreamForUTF8()
		stream.Open
		stream.WriteText c.LabelsCSV, 1
		stream.WriteText c.FieldsCSV, 1
		stream.SaveToFile pOutputfile, 2
		stream.Close
	End Function

	Function GetJsonObjectFromUrl(pUrl)
		Dim oHTTP : Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
		oHTTP.Open "GET", EndPoint & pUrl, False
		oHTTP.SetRequestHeader "Content-Type", "application/json"
		oHTTP.SetRequestHeader "Authorization", "Bearer " & Me.AccessToken
		oHTTP.Send()

		Set GetJsonObjectFromUrl = GetJsonObjectFromText(oHTTP.ResponseText)
		Set oHTTP = Nothing
	End Function

	Function GetJsonObjectFromUrlEx(pUrl)
		Dim oHTTP : Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
		oHTTP.Open "GET", EndPoint & pUrl, False
		oHTTP.SetRequestHeader "Content-Type", "application/json"
		oHTTP.SetRequestHeader "Authorization", "Bearer " & Me.AccessToken
		oHTTP.Send()

		GetJsonObjectFromTextEx(oHTTP.ResponseText)
		Set oHTTP = Nothing
	End Function

	Function GetHttpObjectFromUrlAsync(pUrl)
		Dim oHTTP : Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
		oHTTP.Open "GET", EndPoint & pUrl, True
		oHTTP.SetRequestHeader "Content-Type", "application/json"
		oHTTP.SetRequestHeader "Authorization", "Bearer " & Me.AccessToken
		oHTTP.Send()

		Set GetHttpObjectFromUrlAsync = oHTTP
	End Function

	Function AppendJsonRecordsToCsvAsync(pOutputFile, pJsonData)
		Set Me.JsonObject = _
			GetJsonObject( _
				GetJsonRecordsToCsvForInnerJson( _
					pJsonData _
				) _
			)
		Dim isDone
		isDone = Me.JsonObject.Json.done

		Dim oHTTP
		If Not isDone Then
			Set oHTTP = GetHttpObjectFromUrlAsync(Me.JsonObject.Json.nextRecordsUrl)
		End If
		
		AppendCsvData pOutputFile, Me.JsonObject.getCsvData(Me.FieldsCSV)
		
		If isDone Then
			Exit Function
		End If

		If oHTTP.readyState <> 4 Then
    			oHTTP.waitForResponse(600)
		End If

		Dim json
		json = oHTTP.ResponseText
		Set oHTTP = Nothing

		AppendJsonRecordsToCsvAsync pOutputFile, json
	End Function

	Function AppendCsvData(pOutputFile, pCsvData)
		Dim stream
		Set stream = GetAdodbStreamForUTF8()
		stream.Open
		stream.LoadFromFile pOutputFile
		stream.Position = stream.Size
		stream.WriteText pCsvData
		stream.SaveToFile pOutputFile, 2
		stream.Close
		Set stream = Nothing
	End Function

	Function GetJsonRecordsToCsvForInnerJson(jsondata)
		Dim jsondataEx
		Dim fnc
		fnc = "function(fields){ var fArr = fields.split(','); var ret = ''; for(i = 0; i<this.Json.records.length; i++){for(f = 0; f<fArr.length; f++){if(f != 0){ret += ','};if(!isNaN(this.Json.records[i][fArr[f]])){ret +='='};ret += '""' + String(this.Json.records[i][fArr[f]]).replace('""', '""""').replace('\r\n', '\n') + '""'} ret += '\r\n'}return ret;}"
		jsondataEx = "{ ""getCsvData"": " & fnc & ",""Json"":" + jsondata + "}"
		GetJsonRecordsToCsvForInnerJson = jsondataEx
	End Function

	Function GetRecordValue(pRowNumber, pFieldName)
		Dim records
		Set records = Me.JsonObject.records
		GetRecordValue = Eval("records.[" & pRowNumber & "]." & pFieldName)
		If Err.Number <> 0 Then
			MsgBox pRowNumber & "," & pFieldName & ":Err" & Err.Message
		End If
	End Function

	Function GetTextWriterForShiftJis(pFileName)
		Dim fs
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set GetTextWriterForShiftJis = fs.OpenTextFile(pFileName, 2, True, False)
	End Function

	Function GetTextAppendWriterForShiftJis(pFileName)
		Dim fs
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set GetTextAppendWriterForShiftJis = fs.OpenTextFile(pFileName, 8, True, False)
	End Function

	Function GetAdodbStreamForUTF8()
		Dim s
		Set s = CreateObject("ADODB.Stream")
		s.Type = 2
		s.Charset = "UTF-8"
		Set GetAdodbStreamForUTF8 = s
	End Function
	
	Function CreateTemplateFiles(pScenarioFolder)
		Dim json
		json = GetHttpResonseTextByGet("/services/data/v53.0/sobjects/")
		Set Me.JsonObject = GetJsonObject(GetJsonGlobalDescribeForInnerJson(json))
		Dim sobjectsCSV
		sobjectsCSV = Me.JsonObject.getSObjects()
		Dim sobjects
		sobjects = Split(sobjectsCSV, ",")
		For Each sobjectName in sobjects
			If sobjectName <> "" Then
				Dim sobjectDescribeUrl
				sobjectDescribeUrl = "/services/data/v53.0/sobjects/" & sobjectName & "/describe"
				json = GetHttpResonseTextByGet(sobjectDescribeUrl)
				Set Me.JsonObject = GetJsonObject(GetJsonFieldsForInnerJson(json))
				Dim templateFilePath
				templateFilePath = pScenarioFolder & "\テンプレート\" & Me.JsonObject.Json.label & "_template_" & sobjectName & ".csv"
				Dim stream : Set stream = GetAdodbStreamForUTF8
				stream.Open
				stream.WriteText Me.JsonObject.getFields()
				stream.SaveToFile templateFilePath, 2
				stream.Close
			End If
		Next
	End Function

	Function GetJsonGlobalDescribeForInnerJson(jsondata)
		Dim jsondataEx
		Dim fnc
		fnc = "function(){var ret = ''; for(i = 0; i < this.Json.sobjects.length; i++){if(this.Json.sobjects[i].searchable){ret += this.Json.sobjects[i].name + ','}}return ret;}"
		jsondataEx = "{ ""getSObjects"": " & fnc & ",""Json"":" + jsondata + "}"
		GetJsonGlobalDescribeForInnerJson = jsondataEx
	End Function

	Function GetJsonFieldsForInnerJson(jsondata)
		Dim jsondataEx
		Dim fnc
		fnc = "function(){var retLabels = '';var retNames = ''; for(i = 0; i < this.Json.fields.length; i++){if(i != 0){retNames += ',';retLabels += ',';};retNames += this.Json.fields[i].name;retLabels += this.Json.fields[i].label;}return retLabels + '\r\n' + retNames;}"
		jsondataEx = "{ ""getFields"": " & fnc & ",""Json"":" + jsondata + "}"
		GetJsonFieldsForInnerJson = jsondataEx
	End Function

End Class
'Ver 2022/03/22

引数

１．endpoint

：Salesforceのログイン先URLです。(末尾スラッシュ無し)
　ex：https://sample-dev-ed.my.salesforce.com

２．client_id

：Salesforce上で接続アプリケーションの作成を行った際のコンシューマ鍵の文字列
　ex：3MVG95mg0lk4batiTp4.qhyBwgJmnATd2Q_hD6m79H.YiNOOOqmVxREishaeTImADLMJWE2lob9JfpUlx3ybV

３．client_secret

：Salesforce上で接続アプリケーションの作成を行った際のコンシューマの秘密の文字列
　ex：C1C295679976399E600CCE57D551577177E8A4B6677DFBE3501CF66A325C9E52

４．username

：Salesforceにログインする際のメールアドレス
　ex：sample@sample.com

５．password

：Salesforceにログインする際のパスワード
　ex：a-345678

６．secretToken

：Salesforceで私のセキュリティトークンのリセットを行った際にメールで送られてくる文字列
　ex：hjHD1ZHPlRR1FIpj24hBstTq

７．テンプレートCSV

：このライブラリ独自の引数。実行時にシナリオファイル直下に「テンプレート」というフォルダが作成され、
　そこにアクセス可能なデータ用のテンプレートCSVファイルが[日本語名]template[物理名].csvというファイル名で作成される。
　そのCSVファイル名をフルパスで設定する。
　ex：C:\Salesforceサンプル\テンプレート\リード_template_Lead.csv

８．データ絞込条件

：APIに渡す際の絞込条件。空でも利用可能
　ex：

９．データ取得上限数

：データ取得する際の上限件数。
　ex：500

１０．出力先CSV

：取得したデータはテンプレートファイルをコピーした状態後、CSVファイル形式で保存される。
　ファイルは、ヘッダーが２行で表示名が一行目、二行目が物理名となっており、データは三行目以降に記載される。
　フルパスで指定
　ex：リード.csv

１１．シナリオフォルダ名

：シナリオファイルを配置しているパス。末尾の\は不要。
　ex：C:\Salesforceサンプル

１２．access_token

：実行中に指定したアクセストークンを返す変数名。呼び出すときは空でOK。

エラーが出たときの参考記事

「IP制限を緩和」＋セキュリティトークン無しで動作

上記の
・接続アプリケーションの管理で「IP制限を緩和」に設定されている
->passwordの末尾にセキュリティトークンが付与されていないことを確認。IP制限を緩和の場合はセキュリティトークンは不要
に嵌って30分ほどロスしました・・・

Postman を使って色々検証

下記のツールを使ってWebAPIのレスポンス等を検証しました。フリーで使えてかなりお役立ちでした。
https://www.postman.com/

PostmanとSalesforceに関するお役立ち記事

1
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
1
0