VBAからSlackに画像を投稿する

![スクリーンショット 2024-01-30 135647.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3630756/0b0caffd-1b96-5e55-3346-62d57698b805.png)

# 準備

## Tokenの取得
以下の記事を参考に、インストールとトークンの取得を行う。
[Slackでアプリケーションを作成し、OAuth Tokenを発行するまで](https://qiita.com/kobayashi_ryo/items/a194e620b49edad27364)

Bot TokenとUser Tokenはどちらでも問題ない。
Scopeはfiles:writeを選択すること。

## アプリの追加
Slackの画面から、サイドバーの「アプリを追加する」をクリック。
先ほどインストールしたアプリを選択して追加。
![スクリーンショット 2024-01-26 143607.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3630756/9dded82d-5307-9993-baaf-3ad26fb8e290.png)

サイドバーのAppに追加したアプリが表示されているため、右クリックしてメニューから「アプリの詳細を表示する」を選択。
詳細画面の「チャンネルにこのアプリを追加する」より投稿したいチャンネルを選択
![スクリーンショット 2024-01-30 100443.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3630756/d8a813c4-52f2-84bb-c0b7-2c71befb4614.png)

## チャンネルIDの取得
チャンネルを開いて左上のチャンネル名をクリックし、チャンネル詳細ウィンドウを表示
「チャンネル情報」タブ最下部に表示されているチャンネルIDをコピー
![スクリーンショット 2024-01-30 101929(1).png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3630756/c193c8c2-7b75-358b-68db-29b7daed0302.png)

# VBAコード
```vb
Const urlUp = "https://slack.com/api/files.upload"
Const token = "トークンをここに入力"
Const channelId = "チャンネルIDをここに入力"

'画像のアップロード
Sub postImage()
    
    Const adTypeBinary = 1
    Const adTypeText = 2
    
    Dim boundary As String: boundary = getBoundary
    
    Dim filePath As String: filePath = "画像ファイルのパスをここに入力"
    Dim mimetype As String: mimetype = "画像ファイルのMIMEタイプ、jpegならimage/jpeg"
    Dim fileName As String: fileName = "アップロード後のファイル名"
    
    Dim fileContents
    Dim stream: Set stream = CreateObject("ADODB.Stream")
    stream.Type = adTypeBinary
    stream.Open
    stream.LoadFromFile filePath
    fileContents = stream.Read
    stream.Close
    
    Dim params As String: params = ""
    
    'トークン
    params = params + "--" + boundary + vbCrLf
    params = params + "Content-Disposition: form-data; name=""token""" + vbCrLf + vbCrLf
    params = params + token + vbCrLf
    'チャンネル
    params = params + "--" + boundary + vbCrLf
    params = params + "Content-Disposition: form-data; name=""channels""" + vbCrLf + vbCrLf
    params = params + channelId + vbCrLf
    'ファイルデータ
    params = params + "--" + boundary + vbCrLf
    params = params + "Content-Disposition: form-data; name=""file""; filename=""" + fileName + """" + vbCrLf
    params = params + "Content-Type: " + mimetype + vbCrLf + vbCrLf
    
    stream.Type = adTypeText
    stream.Charset = "UTF-8"
    stream.Open
 
    'テキストデータの書き込み
    changeStreamType stream, adTypeText
    stream.WriteText params
    'バイナリデータの書き込み
    changeStreamType stream, adTypeBinary
    stream.Write fileContents
    '終端
    changeStreamType stream, adTypeText
    stream.WriteText vbCrLf + "--" + boundary + "--" + vbCrLf
    
    changeStreamType stream, adTypeBinary
    stream.Position = 0
    Dim formData: formData = stream.Read
    stream.Close

    'http送信
    Dim http As XMLHTTP60
    Set http = New XMLHTTP60
    With http
        .Open "POST", urlUp
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" + boundary
        .setRequestHeader "Authorization", "Bearer " + token
        .send (formData)
    End With
    
    Dim response As String
    response = http.responseText

    Set http = Nothing
    
    If InStr(response, """ok"":false") Then
        MsgBox "画像の投稿に失敗しました。"
        End
    End If

End Sub

'stream type変更
Private Function changeStreamType(stream, t)
    Dim p: p = stream.Position
    stream.Position = 0
    stream.Type = t
    stream.Position = p
    Set changeStreamType = stream
End Function

'boundary生成
Private Function getBoundary() As String

    Static sBoundary As String

    If sBoundary = "" Then

        Dim multipartChars As String: multipartChars = "-_1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
        Dim boundary As String: boundary = "--------------------"

        Dim i, point As Integer

        For i = 1 To 20
            Randomize
            point = Int(Len(multipartChars) * Rnd + 1)
            boundary = boundary + Mid(multipartChars, point, 1)
        Next

        sBoundary = boundary + Format(Now, "yyyymmddHHMMSS")

    End If

    getBoundary = sBoundary

End Function
```

## 補足
### 引数の追加
files.uploadに引数を追加する場合はparamsにname=引数名で項目を追加する
```vb
params = params + "--" + boundary + vbCrLf
params = params + "Content-Disposition: form-data; name=""引数名""" + vbCrLf + vbCrLf
params = params + "hogehoge" + vbCrLf
```

### チャンネルIDの省略
channelsを省略すると投稿を伴わず画像のアップロードのみが行われる。
httpレスポンスから画像のURLが取得可能。

# 参考
[files.upload method | Slack](https://api.slack.com/methods/files.upload)
[Excel-VBAによるサイボウズkintoneへのバイナリファイルアップロードのサンプル](https://gist.github.com/yamaryu0508/11404242)