趣味の顕微鏡あそび

妻曰く、道具をそろえ終わると趣味が終わるそうだ。

ブログタイトル

エクセルからチャットワークへ

出来るらしいのでやってみた。

エクセルでマクロしか使ったことがないが、なんとかやってみる。
 
まずチャットワークに投稿しないといけないのでやり方を調べる。
 
 
ここが詳しい。
 
APIトークンは、自分の名前からサービス連携を選ぶとある。
APITOKENって書いてある。長い文字列
 
ルームIDは投稿したいルームのID、アドレスの※の数字
https://www.chatwork.com/#!rid※※※※※※※※
 
アカウントIDは自分のIDらしい。
 
 
でもやりたいのは、セルの内容(BA31からBA44)をチャットワークに投稿したいので、書き換える。
 
なんかもっとスマートに書けると思うのだが、さっぱりわからないし、
できたからいいか。。。
Sub sendChat(ByVal roomId As String, ByVal message As String)

Const API_TOKEN As String = ""xxxxxAPIトークンxxxxx"

Dim httpReq As MSXML2.XMLHTTP
Set httpReq = CreateObject("MSXML2.XMLHTTP")
windows7の場合は上のようにしないと動かない。
With httpReq
.Open "POST", "https://api.chatwork.com/v2/rooms/" & roomId & "/messages"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "X-ChatWorkToken", API_TOKEN
.Send "body=" & message
End With
Set httpReq = Nothing
end sub  
Sub チャットワークに送信()

Dim gen01 As String
Dim gen02 As String
Dim gen03 As String
Dim gen04 As String
Dim gen05 As String
Dim gen06 As String
Dim gen07 As String
Dim gen08 As String
Dim gen09 As String
Dim gen10 As String
Dim gen11 As String
Dim gen12 As String
Dim gen13 As String
Dim gen14 As String

'gen01からgen14までの変数の箱を作ってセルの値を入れる。
gen01 = Range("BA31").Value
gen02 = Range("BA32").Value
gen03 = Range("BA33").Value
gen04 = Range("BA34").Value
gen05 = Range("BA35").Value
gen06 = Range("BA36").Value
gen07 = Range("BA37").Value
gen08 = Range("BA38").Value
gen09 = Range("BA39").Value
gen10 = Range("BA40").Value
gen11 = Range("BA41").Value
gen12 = Range("BA42").Value
gen13 = Range("BA43").Value
gen14 = Range("BA44").Value

'****にルームIDとアカウントIDを入れる。&vbLfは改行らしい。


Const ROOM_ID As String = "*****" 'ルームID
Const ACCOUNT_ID As String = "*******" 'アカウントID

Dim msg As String
msg = "[To:" & ACCOUNT_ID & "][info]"
msg = msg & "原料を発注しました" & vbLf & vbLf
msg = msg & gen01 & vbLf
msg = msg & gen02 & vbLf
msg = msg & gen03 & vbLf
msg = msg & gen04 & vbLf
msg = msg & gen05 & vbLf
msg = msg & gen06 & vbLf
msg = msg & gen07 & vbLf
msg = msg & gen08 & vbLf
msg = msg & gen09 & vbLf
msg = msg & gen10 & vbLf
msg = msg & gen11 & vbLf
msg = msg & gen12 & vbLf
msg = msg & gen13 & vbLf
msg = msg & gen14 & vbLf
msg = msg & "[/info]"

Call sendChat(ROOM_ID, msg)

End Sub