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

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

新規登録して質問してみよう
ただいま回答率
87.20%
LINE Messaging API

LINE Messaging APIは、メッセージの送信・返信ができるAPIです。Web APIを経由しアプリケーションサーバとLINEのAPIでやり取りが可能。複数のメッセージタイプや分かりやすいAPIリファレンスを持ち、グループチャットにも対応しています。

VBA

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

受付中

VBAにてラインワークスのコンテンツアップロードの方法

carrotyou
carrotyou

総合スコア0

LINE Messaging API

LINE Messaging APIは、メッセージの送信・返信ができるAPIです。Web APIを経由しアプリケーションサーバとLINEのAPIでやり取りが可能。複数のメッセージタイプや分かりやすいAPIリファレンスを持ち、グループチャットにも対応しています。

VBA

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

1回答

-1評価

0クリップ

1247閲覧

投稿2019/08/29 04:22

編集2022/01/12 10:55

参考URL
https://developers.worksmobile.com/jp/document/1005025?lang=ja

VBAでラインワークスのコンテンツアップロードを行いたいのですが

下記エラーが表示されます。
実行時エラー '-2146697208(800c0008)'
指定されたリソースのダウンロードに失敗しました。

以下、コードです。
'
Function CreateNomarlParameter(fct, fctm)
s = ""
s = s & fct & fctm & vbCrLf
s = s & vbCrLf
CreateNomarlParameter = s
End Function

Function CreateFileParmaterPrefix(fname, fvalue, fct)
s = ""
s = s & strBoundary & vbCrLf
s = s & "Content-Disposition: form-data; name=""" & fname & """; filename=""" & fvalue & """" & vbCrLf
s = s & "Content-Type: " & fct & vbCrLf
CreateFileParmaterPrefix = s
End Function

Private Function ChangeStreamType(stream, adType)
Dim p As Long
p = stream.Position
stream.Position = 0
stream.Type = adType

If adType = adTypeText Then stream.Charset = "UTF-8" End If stream.Position = p Set ChangeStreamType = stream

End Function

Public Function ChangeChr(strXML) As Byte()
Dim objSTREAM As Object
On Error Resume Next
Set objSTREAM = CreateObject("ADODB.Stream")
With objSTREAM
.Open
.Type = adTypeText
.Charset = "UTF-8"
.WriteText strXML
.Position = 0
.Type = adTypeBinary
.Position = 0
ChangeChr = .Read()
End With

objSTREAM.Close: Set objSTREAM = Nothing

End Function

Public Function KickWebApiOfDATA(ByVal request As String, ByVal url As String, Optional ByVal param As String) As Object
Const adTypeBinary = 1
Const adTypeText = 2

Dim json json = ConvertToJson(param) Dim strBoundary: strBoundary = "--" & DateDiff("s", "1970/1/1 0:00:00", DateAdd("h", -9, Now)) Dim endBoundary: endBoundary = vbCrLf & "--" & strBoundary & "--" & vbCrLf Dim StreamB Dim StreamS StreamS = "" Set stream = CreateObject("ADODB.Stream") stream.Open stream.Type = adTypeBinary stream.LoadFromFile param StreamB = stream.Read stream.Close stream.Type = adTypeText stream.Charset = "UTF-8" stream.Open ChangeStreamType stream, adTypeText StreamS = "--" & strBoundary StreamS = StreamS & CreateFileParmaterPrefix("resourceName", Dir(param), "application/octet-stream") StreamS = StreamS & CreateNomarlParameter("Content-Transfer-Encoding: ", "binary") stream.WriteText StreamS ChangeStreamType stream, adTypeBinary stream.Write StreamB ChangeStreamType stream, adTypeText stream.WriteText endBoundary ChangeStreamType stream, adTypeBinary stream.Position = 0 formdata = stream.Read Dim http As Object Set http = CreateObject("Msxml2.XMLHTTP") With http .Open request, url, False .setRequestHeader "consumerKey", Sheet2.Cells(2, 3) .setRequestHeader "authorization", "Bearer " & Sheet2.Cells(3, 3) .setRequestHeader "x-works-apiid", Sheet2.Cells(6, 3) .setRequestHeader "Cache-Control", "no-cache" .setRequestHeader "Content-Length", stream.Size .setRequestHeader "Content-Type", "multipart/form-data; boundary=""" & strBoundary & """" & vbCrLf .Send formdata If .ResponseText <> "" Then Set KickWebApiOfJsonDATA = ParseJson(.ResponseText) Debug.Print .ResponseText End If End With Set http = Nothing stream.Close

End Function

Sub OnClick_PostDATA()
Dim param As String

param = "C:\tools\QRtest.png" Debug.Print JsonConverter.ConvertToJson(param, Whitespace:=2) Call KickWebApiOfDATA("POST", "http://storage.worksmobile.com/openapi/message/upload.api", param)

End Sub
'

OnClick_PostDATA()を呼び出してラインワークスのコンテンツアップロードを行おうとしています。
なお、メッセージの送信はできるので
.setRequestHeader "consumerKey", Sheet2.Cells(2, 3)
.setRequestHeader "authorization", "Bearer " & Sheet2.Cells(3, 3)
.setRequestHeader "x-works-apiid", Sheet2.Cells(6, 3)
に関しては問題ないと思います。

良い質問の評価を上げる

以下のような質問は評価を上げましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

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

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

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

teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

  • プログラミングに関係のない質問
  • やってほしいことだけを記載した丸投げの質問
  • 問題・課題が含まれていない質問
  • 意図的に内容が抹消された質問
  • 過去に投稿した質問と同じ内容の質問
  • 広告と受け取られるような投稿

評価を下げると、トップページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

まだ回答がついていません

会員登録して回答してみよう

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

ただいまの回答率
87.20%

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

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

質問する

関連した質問

同じタグがついた質問を見る

LINE Messaging API

LINE Messaging APIは、メッセージの送信・返信ができるAPIです。Web APIを経由しアプリケーションサーバとLINEのAPIでやり取りが可能。複数のメッセージタイプや分かりやすいAPIリファレンスを持ち、グループチャットにも対応しています。

VBA

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