ExcelVBAからGoogleChatへ投稿する
Q&A
Closed
解決したいこと
ExcelVBAにて、Excelの特定のセルの内容をGoogleチャットのスペースに投稿できるようにしたい。
そのためのロジックを記載したものの、VBAのコンパイルは通るが、通信が恐らくできずGoogleチャットに投稿されないため、どこが原因でどうすれば解消されるかを知りたい。
※元々Excel⇒Chatworkに投稿は出来ていたので、そのノリで出来ると思ったのが間違いだった…。
発生している問題・エラー
エラーというエラーは出ていない為、困っていることが問題…。
該当するソースコード
'プログラム0｜変数設定の指定
Option Explicit
'プログラム1｜プログラム開始
Sub ChatWorkにメッセージを投稿()
'プログラム2｜シート設定
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("通知用")
'プログラム3｜Googleチャットのwebhook
Dim url As String
url = "https://chat.googleapis.com/hogehoge" 'Googleチャットのスペースwebhook
'プログラム4｜APIトークンを設定(Googleチャットでは使わない？)
'Dim apitoken As String: apitoken = ws.Range("B7").Value
'プログラム5｜Chatworkメッセージを取得
Dim title As String: title = Replace(ws.Range("B8").Value, "{日付}", Format(Date, "yyyy-mm-dd"))
Dim message0 As String: message0 = ws.Range("B5").Value
Dim message1 As String: message1 = Replace(ws.Range("B9").Value, "{日付}", Format(Date, "yyyy-mm-dd"))
Dim message2 As String: message2 = Replace(ws.Range("B10 ").Value, "{日付}", Format(Date, "yyyy-mm-dd"))
Dim message3 As String: message3 = Replace(ws.Range("B11 ").Value, "{日付}", Format(Date, "yyyy-mm-dd"))
Dim message4 As String: message4 = ws.Range("B12 ").Value
Dim message5 As String: message5 = ws.Range("B13").Value
Dim message6 As String: message6 = ws.Range("B14").Value
Dim message7 As String: message7 = ws.Range("B15").Value
Dim message8 As String: message8 = ws.Range("B16").Value
Dim message9 As String: message9 = ws.Range("B17").Value
Dim message10 As String: message10 = ws.Range("B18").Value
Dim message11 As String: message11 = ws.Range("B19").Value
Dim message12 As String: message12 = ws.Range("B20").Value
Dim text As String: text = "[info][title]" & title & "[/title]" & "【担当者】" & message0 & vbCrLf & "【受付日】" & message1 & vbCrLf & "【○○日】" & message2 & vbCrLf & "【○○日】" & message3 & vbCrLf & "【○○】" & message4 & vbCrLf & "【○○1】" & message5 & vbCrLf & "【○○2】" & message6 & vbCrLf & "【○○3】" & message7 & vbCrLf & "【○○4】" & message8 & vbCrLf & "【○○5】" & message9 & vbCrLf & "【○○6】" & message10 & vbCrLf & "【○○】" & message11 & vbCrLf & "【○○】" & message12 & vbCrLf & "[/info]"
'プログラム6｜POSTするメッセージを設定
Dim param As String
param = "body=" & text
'プログラム7｜GoogleチャットにデータをPOSTする
Dim objHTTP As XMLHTTP60
Set objHTTP = New XMLHTTP60
With objHTTP
.Open "POST", url
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'.setRequestHeader "X-ChatWorkToken", apitoken 'googleチャットにしたから要らないはず
.send (param)
End With
'プログラム8｜通知の状況を出力
If InStr(objHTTP.responseText, "message_id") > 0 Then
ws.Range("F15").Value = "通知成功"
Else
ws.Range("F15").Value = "通知失敗"
End If
'ws.Range("F15").Value = objHTTP.responseText
'プログラム9｜オブジェクト解放
Set objHTTP = Nothing
'プログラム10｜プログラム終了
End Sub
自分で試したこと
元はExcel⇒Chatwork用のVBAだったので、以下箇所を修正。
・APIトークン部分はGoogleチャットのwebhookに。
・ChatworkのroomidはGoogleチャットでは不要かと思い、コメント化。
・「'プログラム7｜GoogleチャットにデータをPOSTする」部分の
「.setRequestHeader」でChatworkのトークン部分についても不要かと考え、コメント化。
尚、「'プログラム8｜通知の状況を出力」部分のロジックで、
セルに通信状態を表示するようにしているが、「通信失敗」となる。
そもそもPOSTのロジックに関する記事や、
ましてGoogleチャットへExcelVBAから連携する記事が圧倒的に少なく、
プログラミングやVBA初心者には手詰まり状態です。
0 likes
