【VBA】ツイッターAPIを使ってツイートする（外部ソフト無し）

スポンサーリンク
エクセル
2021.07.23
スポンサーリンク

ツイッターAPIを使ってエクセルVBAからツイートをする方法を紹介します。

※自動化などをするときはツイッターAPIの規約に従って運用を行ってください。
規約を違反した場合はアカウントロックや凍結されることがあると認識して利用してください。

ここで紹介する方法は外部のソフトやライブラリを使わず、VBA内で処理を完結します。

スポンサーリンク

環境条件

条件として

  • microsoftエクセル（バージョン未検証）
  • ネットにつながった環境
  • ツイッターAPIの認証情報

が必要です。

エクセルはもちろんで、ツイート自体はHTTP通信を使って行われますのでネットにつながった環境も必要です。

「ツイッターAPIの認証情報」はAPI認証情報の取得方法をご覧頂き取得をしてください。

またエクセルのVBE画面で「ツール」⇒「参照設定」からライブラリの読み込みをします。

  • Microsoft WinHTTP Service version 5.1
  • Microsoft XML, v6.0

上記を参照設定でチェックしておきましょう。

シート

簡単にユーザー名と認証情報、ツイートの内容を記載したシートを用意します。

C列に情報を記載しています。

簡単にボタンを設置しています。

ソース

以下はソースです。

標準モジュール

twitter_apiとして

#If VBA7 Then
	Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
	Public Declare PtrSafe Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
	Public Declare PtrSafe Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As LongPtr
	Public Declare PtrSafe Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As LongPtr
	Public Declare PtrSafe Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As LongPtr
#Else
	Public Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
	Public Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
	Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
	Public Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
	Public Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
#End If

Public Type FILETIME
	dwLowDateTime As Long
	dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
	wYear As Integer
	wMonth As Integer
	wDayOfWeek As Integer
	wDay As Integer
	wHour As Integer
	wMinute As Integer
	wSecond As Integer
	wMilliseconds As Integer
End Type

Const adTypeBinary = 1
Const adTypeText = 2

Const HT_APIMethodP As String = "POST"

Const HT_URLPost As String = "https://api.twitter.com/1.1/statuses/update.json"
Const HT_URLStatus As String = "https://api.twitter.com/oauth2/token"

Const HT_Method As String = "HMAC-SHA1"
Const HT_OauthVersion As String = "1.0"

Function HT_Username() As Variant
	HT_Username = "@" & ThisWorkbook.Worksheets("sheet1").Range("C2").Value
End Function
Function HT_OauthConsumerKey() As Variant
	HT_OauthConsumerKey = ThisWorkbook.Worksheets("sheet1").Range("C3").Value
End Function
Function HT_OauthConsumerSecret() As Variant
	HT_OauthConsumerSecret = ThisWorkbook.Worksheets("sheet1").Range("C4").Value
End Function
Function HT_OauthToken() As Variant
	HT_OauthToken = ThisWorkbook.Worksheets("sheet1").Range("C5").Value
End Function
Function HT_OauthTokenSecret() As Variant
	HT_OauthTokenSecret = ThisWorkbook.Worksheets("sheet1").Range("C6").Value
End Function

Public Function LocalTimeToUTC(dteTime As Date) As Date
	Dim dteLocalFileTime As FILETIME
	Dim dteFileTime As FILETIME
	Dim dteLocalSystemTime As SYSTEMTIME
	Dim dteSystemTime As SYSTEMTIME

	dteLocalSystemTime.wYear = CInt(Year(dteTime))
	dteLocalSystemTime.wMonth = CInt(Month(dteTime))
	dteLocalSystemTime.wDay = CInt(Day(dteTime))
	dteLocalSystemTime.wHour = CInt(Hour(dteTime))
	dteLocalSystemTime.wMinute = CInt(Minute(dteTime))
	dteLocalSystemTime.wSecond = CInt(Second(dteTime))

	Call SystemTimeToFileTime(dteLocalSystemTime, dteLocalFileTime)
	Call LocalFileTimeToFileTime(dteLocalFileTime, dteFileTime)
	Call FileTimeToSystemTime(dteFileTime, dteSystemTime)

	LocalTimeToUTC = CDate(dteSystemTime.wMonth & "/" & _
	dteSystemTime.wDay & "/" & _
	dteSystemTime.wYear & " " & _
	dteSystemTime.wHour & ":" & _
	dteSystemTime.wMinute & ":" & _
	dteSystemTime.wSecond)
End Function

Public Function get_timestamp() As Variant
	get_timestamp = DateDiff("s", #1/1/1970#, LocalTimeToUTC(Now))
End Function

Public Function EncodeBase64(ByRef arrData() As Byte) As Variant

	Dim objXML As MSXML2.DOMDocument60
	Dim objNode As MSXML2.IXMLDOMElement
	Set objXML = New MSXML2.DOMDocument60

	Set objNode = objXML.createElement("b64")
	objNode.DataType = "bin.base64"
	objNode.nodeTypedValue = arrData
	EncodeBase64 = objNode.Text

	Set objNode = Nothing
	Set objXML = Nothing

End Function

Public Function Base64_HMACSHA1(ByVal sTextToHash As Variant, ByVal sSharedSecretKey As Variant) As Variant

	Dim asc As Object
	Dim enc As Object
	Dim TextToHash() As Byte
	Dim SharedSecretKey() As Byte

	Set asc = CreateObject("System.Text.UTF8Encoding")
	Set enc = CreateObject("System.Security.Cryptography.HMACSHA1")

	TextToHash = asc.Getbytes_4(sTextToHash)
	SharedSecretKey = asc.Getbytes_4(sSharedSecretKey)
	enc.Key = SharedSecretKey

	Dim bytes() As Byte
	bytes = enc.ComputeHash_2((TextToHash))
	Base64_HMACSHA1 = EncodeBase64(bytes)
	Set asc = Nothing
	Set enc = Nothing

End Function

Public Function get_GUID() As Variant
	get_GUID = RandomHex(3) + "-" + _
	RandomHex(2) + "-" + _
	RandomHex(2) + "-" + _
	RandomHex(2) + "-" + _
	RandomHex(6)
End Function

Private Function RandomHex(lngCharLength As Long)
	Dim i As Long
	Randomize
	For i = 1 To lngCharLength
		RandomHex = RandomHex & Right$("0" & Hex(Rnd() * 256), 2)
	Next
End Function

Private Function strToByteArray(sText As Variant) As Byte()
	strToByteArray = StrConv(sText, vbFromUnicode)
End Function

Public Function UrlEncode(str As Variant)
	Dim d As Object
	Dim elm As Object
	Set d = CreateObject("htmlfile")
	Set elm = d.createElement("span")
	str = Replace(str, vbCrLf, vbLf)
	str = Replace(str, vbLf, "n")
	elm.setAttribute "id", "result"
	d.body.appendChild elm
	Debug.Print str
	d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & str & "');", "JScript"
	'Debug.Print elm.innerText
	UrlEncode = elm.innerText
End Function

Public Function get_basestring(strNonce As Variant, strTimestamp As Variant, strStatus As Variant) As Variant
	Dim HT_tmpbase As Variant
	HT_tmpbase = "oauth_consumer_key=" & HT_OauthConsumerKey
	HT_tmpbase = HT_tmpbase & "&" & "oauth_nonce=" & strNonce
	HT_tmpbase = HT_tmpbase & "&" & "oauth_signature_method=" & HT_Method
	HT_tmpbase = HT_tmpbase & "&" & "oauth_timestamp=" & strTimestamp
	HT_tmpbase = HT_tmpbase & "&" & "oauth_token=" & HT_OauthToken
	HT_tmpbase = HT_tmpbase & "&" & "oauth_version=" & HT_OauthVersion
	HT_tmpbase = HT_tmpbase & "&" & "status=" & strStatus
	get_basestring = HT_APIMethodP & "&" & UrlEncode((HT_URLPost)) & "&" & UrlEncode(HT_tmpbase)
End Function

Public Function get_header(strNonce As Variant, strTimestamp As Variant, strSignature As Variant) As Variant
	Dim HT_tmpHeader As Variant
	HT_tmpHeader = "OAuth oauth_consumer_key=" & Chr(34) & HT_OauthConsumerKey & Chr(34)
	HT_tmpHeader = HT_tmpHeader & ", oauth_nonce=" & Chr(34) & strNonce & Chr(34)
	HT_tmpHeader = HT_tmpHeader & ", oauth_signature=" & Chr(34) & strSignature & Chr(34)
	HT_tmpHeader = HT_tmpHeader & ", oauth_signature_method=" & Chr(34) & HT_Method & Chr(34)
	HT_tmpHeader = HT_tmpHeader & ", oauth_timestamp=" & Chr(34) & strTimestamp & Chr(34)
	HT_tmpHeader = HT_tmpHeader & ", oauth_token=" & Chr(34) & HT_OauthToken & Chr(34)
	HT_tmpHeader = HT_tmpHeader & ", oauth_version=" & Chr(34) & HT_OauthVersion & Chr(34)
	HT_tmpHeader = HT_tmpHeader & ", trim_user=false"
	get_header = HT_tmpHeader
End Function


Public Function send_tweet(strStatus As Variant) As Boolean
	'ツイート内容をURLエンコードする
	strStatus = UrlEncode(strStatus)
	'nonceを作成
	strNonce = get_GUID()
	'タイムスタンプを作成
	strTimestamp = get_timestamp()
	'認証ヘッダーの元を作成
	strBase = get_basestring(strNonce, strTimestamp, strStatus)
	'composite keyを作成
	strKey = HT_OauthConsumerSecret & "&" & HT_OauthTokenSecret
	'認証ヘッダーの元を加工
	strOauthSig = UrlEncode(Base64_HMACSHA1(strBase, strKey))
	'認証header作成
	strHeader = get_header(strNonce, strTimestamp, strOauthSig)

	'HTTPでコネクション作成
	Dim objRest As WinHttp.WinHttpRequest
	Set objRest = New WinHttp.WinHttpRequest
	objRest.Open HT_APIMethodP, HT_URLPost, False
	objRest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
	objRest.setRequestHeader "Authorization", strHeader
	objRest.send "status=" & strStatus
	objRest.waitForResponse
	' Debug.Print objRest.Status & " -- " & objRest.statusText
	' Debug.Print objRest.responseText
	If objRest.Status = "200" Then
		send_tweet = True
	Else
		send_tweet = False
	End If
	Set objRest = Nothing

End Function

本体は「send_tweet」です。

その他は細かいエンコードや暗号化、変換構築機能です。

処理の流れ的には、

API認証情報でHTTPレスポンスヘッダーを作成して、objRest.sendでツイートを送信します。

ヘッダーを作成するときに暗号化やエンコードをいくつか行いますがここが肝です。

ここで正確なヘッダーを作成しないとエラーになってしまいます。カスタムする時は気をつけましょう。

また、認証情報が誤っていてエラーになるケースも多いので注意しましょう。

コマンドボタン

下記はコマンドボタンのソースです。

Private Sub CommandButton1_Click()
	strStatus = ThisWorkbook.Worksheets("sheet1").Range("C8").Value
	strStatus = Replace(strStatus, "(", "（") 
	strStatus = Replace(strStatus, ")", "）") 
	strStatus = Replace(strStatus, "*", "＊") 
	strStatus = Replace(strStatus, "!", "！") 
	Call send_tweet(strStatus)
End Sub

ツイート内容を少々加工しています。

ツイート内容はエンコードして送信しますが、一部半角文字でエラーが出るので全角に変換して送信します。

文字数のチェックは入れていませんが文字数がオーバーしているとエラーになるので注意です。エクセルに入力する時点で判定するなどの方がよろしいかもしれません。

 

 

これを利用して自動化やツイート内容の自動生成等が可能になります。

また、画像付きのツイートをしたりすることもできるのですが、少々方法が変わります。

画像付き自動ツイートをご要望の方は当方で販売を行っていますのでご覧いただけると幸いです。

エクセルからツイッターAPIで自動投稿するファイルを販売しています

また、ここでは入っていませんが、フィルターしたツイートを取得する、ツイートを削除するなども実装することが可能です。

こちらはまた違う機会で紹介します。

スポンサーリンク

コメント

タイトルとURLをコピーしました