Excel-VBAによるサイボウズkintoneへのバイナリファイルアップロードのサンプル

kintone-fileUpload.vb

Sub fileUpload()
  ''''''''
  ' http://trash-area.com/archives/649 を参考に作成
  ''''''''
  ' ファイルの情報設定
  localfileName = "c:\photo3.jpg"  'アップロード元のファイル
  FileName = "image.jpeg"  'アップロード後のファイル名
  mimeType = "image/jpeg"  'ファイルのmime-type
  ' kintoneアクセス情報の設定
  subdomain = "[your subdomain]" 'サブドメイン
  authToken = "[your base64-encoded string]" '「ユーザID : パスワード」のbase64エンコードストリング

  Const adTypeBinary = 1
  Const adTypeText = 2
  Boundary = "---------------------------20111107kintone20111107cybozucom"
  END_BOUNDARY = vbCrLf + "--" + Boundary + "--" + vbCrLf
    
  Dim fileContents
  Dim stream: Set stream = CreateObject("ADODB.Stream")
  stream.Type = adTypeBinary
  stream.Open
  stream.LoadFromFile localfileName
  fileContents = stream.Read
  stream.Close
  
  Dim params: params = vbCrLf
  params = params + "--" + Boundary + vbCrLf
  params = params + "Content-Disposition: form-data; name=""" + "file" + """;"
  params = params + " 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 END_BOUNDARY
 
  ChangeStreamType stream, adTypeBinary
  stream.Position = 0
  formData = stream.Read
  stream.Close
  
  ' HTTPSリクエスト
  Set http = CreateObject("WinHttp.WinHttpRequest.5.1")

  http.Open "POST", "https://" + subdomain + ".cybozu.com/k/v1/file.json", False
  http.SetRequestHeader "X-Cybozu-Authorization", authToken

  http.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & Boundary
 
  http.Send formData

  ' fileKeyの取得
  MsgBox http.ResponseText
  Debug.Print http.ResponseText
  Range("A1").Value = http.ResponseText

End Sub

Function ChangeStreamType(stream, t)
    p = stream.Position
    stream.Position = 0
    stream.Type = t
    stream.Position = p
    Set ChangeStreamType = stream
End Function