質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.42%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

PDF

PDF(Portable Document Format)とはISOによって国際標準として制定されている電子ドキュメント用の拡張子です。

ChatWork

業務の効率化を目的としたコミュニケーションツール。 グループチャット、ビデオ・音声通話、ファイル共有、タスク管理などの機能を備えています。マルチデバイス対応で、ブラウザだけでなくタブレットやスマートフォンでも利用可能です。

Q&A

解決済

1回答

6847閲覧

VBAでPDFファイルをチャットワークにアップロードしたい

jimuinA

総合スコア5

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

PDF

PDF(Portable Document Format)とはISOによって国際標準として制定されている電子ドキュメント用の拡張子です。

ChatWork

業務の効率化を目的としたコミュニケーションツール。 グループチャット、ビデオ・音声通話、ファイル共有、タスク管理などの機能を備えています。マルチデバイス対応で、ブラウザだけでなくタブレットやスマートフォンでも利用可能です。

0グッド

1クリップ

投稿2020/04/10 06:52

前提・実現したいこと

こんにちは。初めて質問させていただきます。
会社で事務をしている非エンジニアです。

Excelのマクロを利用して、ローカルにあるPDFファイル(請求書)をchatworkにアップロードしようとしています。
ボタンを押したら下記uploadFile()が実行され、Excelと同じフォルダにあるPDFファイルをchatworkにアップロードしたいと思っています。

発生している問題・エラーメッセージ

レスポンスでファイルIDが返ってきますが、該当のチャットにはファイルがアップロードされていません。
コード上でもエラーメッセージはなく正常に終了します。
問題の特定、切り分けができず投稿させていただきました。

該当のソースコード

VBA

1Const adTypeBinary = 1 2Const adTypeText = 2 3 4Const adBTypeContent = 1 5Const adBTypeBody = 2 6Const adBTypeFooter = 3 7 8Public Function uploadFile() As Boolean 9 10 11 Dim FilePath As String: FilePath = ThisWorkbook.Path & "\請求書" & ".pdf" 12 Dim ROOM_ID As String: ROOM_ID = {roomID} 13 Dim strMethod As String: strMethod = "POST" 14 Dim strUri As String: strUri = "https://api.chatwork.com/v2/rooms/" & ROOM_ID & "/files" 15 Dim API_TOKEN As String: API_TOKEN = {APITOKEN} 16 Dim strResult As String 17 18 '--------------------------------- 19 ' リクエストパラメタ用の領域を生成 20 '--------------------------------- 21 Dim tempParamStream As Object 22 Set tempParamStream = CreateObject("ADODB.Stream") 23 tempParamStream.Open 24 25 '--------------------------------- 26 ' リクエストパラメタ作成 27 '--------------------------------- 28 Dim filename As String 29 filename = Dir(FilePath) 30 31 If SetFileParmater(tempParamStream, "file", filename, "application/pdf", FilePath) Then 32 End If 33 34 If SetEndParameter(tempParamStream) Then 35 End If 36 37 '--------------------------------- 38 ' リクエストパラメタ取得 39 '--------------------------------- 40 Dim snedParameter As Variant 41 GetSendParameter snedParameter, tempParamStream 42 43 '--------------------------------- 44 ' リクエスト 45 '--------------------------------- 46 Dim objHTTP As XMLHTTP60 47 Set objHTTP = New XMLHTTP60 48 objHTTP.Open strMethod, strUri, False 49 objHTTP.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + getBoundy(adBTypeContent) 50 objHTTP.setRequestHeader "X-ChatWorkToken", API_TOKEN 51 objHTTP.send snedParameter 52 53 statusCode = objHTTP.Status 54 55 strResult = StrConv(objHTTP.responseBody, vbUnicode) 56 Set objHTTP = Nothing 57 58 uploadFile = True 59End Function 60 61Private Function SetNomarlParameter( _ 62 ByRef tempParamStream As Object, _ 63 ByVal fname As String, _ 64 ByVal fvalue As String) As Boolean 65 66 If fvalue <> "" Then 67 68 ChangeStreamType tempParamStream, adTypeText 69 70 Dim params As String 71 params = "" 72 params = params + getBoundy(adBTypeBody) 73 params = params + "Content-Disposition: form-data; name=""" + fname + """" + "; filename=" + fvalue + vbCrLf 74 params = params + fvalue + vbCrLf 75 76 tempParamStream.WriteText params 77 78 End If 79 80 SetNomarlParameter = True 81End Function 82 83Private Function SetFileParmater( _ 84 ByRef tempParamStream As Object, _ 85 ByVal fname As String, _ 86 ByVal fvalue As String, _ 87 ByVal fct As String, _ 88 ByVal fpath) As Boolean 89 90 '------------------------------------- 91 ' テキストデータ 92 '------------------------------------- 93 ChangeStreamType tempParamStream, adTypeText 94 95 Dim params As String 96 params = "" 97 params = params + getBoundy(adBTypeBody) 98 params = params + "Content-Disposition: form-data; name=""" + fname + """; filename=""" + fvalue + """" + vbCrLf 99 params = params + "Content-Type:" + fct + vbCrLf 100 params = params + vbCrLf 101 102 tempParamStream.WriteText params 103 104 105 '------------------------------------- 106 ' バイナリデータ 107 '------------------------------------- 108 ChangeStreamType tempParamStream, adTypeBinary 109 110 Dim fileStream As Object 111 Set fileStream = CreateObject("ADODB.Stream") 112 fileStream.Type = adTypeBinary 113 fileStream.Open 114 fileStream.LoadFromFile fpath 115 116 tempParamStream.Write fileStream.Read() 117 118 fileStream.Close 119 Set fileStream = Nothing 120 121 SetFileParmater = True 122End Function 123 124Private Function SetEndParameter( _ 125 ByRef tempParamStream As Object) As Boolean 126 127 ChangeStreamType tempParamStream, adTypeText 128 tempParamStream.WriteText getBoundy(adBTypeFooter) 129 130 SetEndParameter = True 131End Function 132 133Private Function GetSendParameter( _ 134 ByRef parameter As Variant, _ 135 ByRef stream As Object) As Boolean 136 137 ChangeStreamType stream, adTypeBinary 138 stream.Position = 0 139 parameter = stream.Read 140 141 stream.Close 142 Set stream = Nothing 143 144 GetSendParameter = True 145End Function 146 147Private Function ChangeStreamType( _ 148 ByRef stream As Object, _ 149 ByVal adType As Integer) As Boolean 150 Dim p As Long 151 p = stream.Position 152 stream.Position = 0 153 stream.Type = adType 154 155 If adType = adTypeText Then 156 stream.Charset = "UTF-8" 157 End If 158 159 stream.Position = p 160 161 ChangeStreamType = True 162End Function 163 164Private Function getBoundy(ByVal adType As Integer) As String 165 166 Static sBoundy As String 167 168 If sBoundy = "" Then 169 170 Dim multipartChars As String: multipartChars = "-_1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" 171 Dim boundary As String: boundary = "--------------------" 172 173 Dim i, point As Integer 174 175 For i = 1 To 16 176 Randomize 177 point = Int(Len(multipartChars) * Rnd + 1) 178 boundary = boundary + Mid(multipartChars, point, 1) 179 Next 180 181 sBoundy = boundary 182 183 End If 184 185 Select Case adType 186 Case adBTypeContent 187 getBoundy = sBoundy 188 Case adBTypeBody 189 getBoundy = "--" + sBoundy + vbCrLf 190 Case adBTypeFooter 191 getBoundy = vbCrLf + "--" + sBoundy + "--" + vbCrLf 192 End Select 193 194End Function 195 196 197

試したこと

こちらを参考にさせていただき、作成しました。
EXCEL(VBA)から、HTTP通信でファイルをアップロードしてみよう。
chatwork API ドキュメント
エクセルVBAでチャットワークに最もシンプルなメッセージを送る方法

同様の問題が発生していると思われるこちらの方を参考に、SetFileParmater()とgetBoundy()の
vbCrLfの数をを減らしてみましたが動作は変わりませんでした。
chatwork-ruby v0.10.0をリリースした

補足情報(FW/ツールのバージョンなど)

Windows10 Home 64bit
Microsoft Office 365 Business

VBAで追加した参照設定

  • Microsoft Scripting Runtime
  • MicrosoftXML v6.0

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

ChangeStreamTypeの
stream.Charset = "UTF-8"

stream.Charset = "Shift-JIS"
にしたらアップロードされました。

また、getBoundyでの乱数で作成したpointの値が0の場合にエラーになるのでそれを回避する処理が必要でした。

投稿2020/12/02 07:28

編集2020/12/02 07:38
HANAMIZAKE

総合スコア9

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jimuinA

2020/12/02 12:19 編集

ありがとうございます! 無事PDFファイルをアップロードできました。 大変助かりました。 追加でもしお分かりになられましたら教えてください。 アップロードした際、ファイル名が「請求書.pdf」とはならず 「??????.pdf 」といった名前に文字化けしてしまいました。 filename = Dir(FilePath) の後に filename = Asc(filename) の1行を追加し、文字コードの変換を行ってみたのですが解決しませんでした。 どうぞよろしくお願いいたします。
jimuinA

2020/12/02 13:16

お騒がせしてすみませんでした。 以下を変更し、自己解決しました。 (PDFのファイル名をURLエンコードして対応しました。) 1.uploadFileに1行追加 変更前 filename = Dir(FilePath) 変更後 filename = Dir(FilePath) filename = Application.WorksheetFunction.EncodeURL(filename) '←この一文を追加 2.SetFileParmaterの内容を変更 変更前 params = params + "Content-Disposition: form-data; name=""" + fname + """; filename=""" + fvalue + """" + vbCrLf 変更後 params = params + "Content-Disposition: form-data; name=""" + fname + """; filename*=utf-8''" + fvalue + vbCrLf 参考にさせていただいた記事 https://qiita.com/khsk/items/d541b8dc40bd2c6128d2 https://www.ka-net.org/blog/?p=1938
HANAMIZAKE

2020/12/03 00:02

無事アップできたようで良かったです。 私も一から作るのが手間だと思っていたときに本記事を見つけたので助かりました。 ありがとうございました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.42%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問