妻一人、子供二人、猫六匹

僕がやったこと。思ったこと。日々の思い出。

VBAでmastodonに繋ぐ

自分用メモ

VBAmastodonに繋ぐ事の需要は全くないと思うけど、途中まで実装したのでメモ。

Public Const MASTODON_HOST As String = "…"
Public Const USER_NAME As String = "…"
Public Const PASSWD As String = "…"
Public Const SCOPE As String = "read%20write%20follow"

Public Sub read()
' ** 変数定義 **
Dim objSC As Object '参照設定でMicrosoft Script Control 1.0をオンにしておく
Dim objXML As Object '参照設定でMicrosoft XML 3.0をオンにしておく

Dim strFunc As String
Dim strJson As String
Dim strURL As String
Dim objJson As Object

Dim strClientId As String
Dim strClientSecret As String

Set objSC = CreateObject("ScriptControl")
Set objXML = CreateObject("Msxml2.XMLHTTP")


objSC.Language = "JScript"
strFunc = "function jsonParse(str) { return eval('(' + str + ')'); };"
objSC.AddCode strFunc

'接続先
strURL = "https://" & MASTODON_HOST & "/api/v1/apps"

objXML.Open "POST", strURL, False

Call objXML.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")

'リクエスト送信
objXML.send "redirect_uris=urn:ietf:wg:oauth:2.0:oob&client_name=" & USER_NAME & "&scopes=read write follow"

'レスポンスセット
strJson = objXML.responseText

Debug.Print strJson
Set objJson = objSC.CodeObject.jsonParse(strJson)
strClientId = objJson.client_id
strClientSecret = objJson.client_secret

Debug.Print strClientId
Debug.Print strClientSecret

strURL = "https://" & MASTODON_HOST & "/oauth/token"
objXML.Open "POST", strURL, False
' Call objXML.setRequestHeader("Content-Type", "application/json")
Call objXML.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
objXML.send "client_id=" & strClientId & "&client_secret=" & strClientSecret & "&grant_type=password&username=" & USER_NAME & "&password=" & PASSWD & "&scope=" & SCOPE

'レスポンスセット
strJson = objXML.responseText
Debug.Print strJson


End Sub


VBAエキスパート公式テキスト Excel VBA ベーシック [模擬問題プログラム付き]

VBAエキスパート公式テキスト Excel VBA ベーシック [模擬問題プログラム付き]