EXCELからWordPressにREST API経由で投稿する。
photo credit: Andrew_Writer DSC00229 via photopin (license)
定期的な投稿を更新をEXCELで管理できたら楽だなと思い自分用に作ったのを記録用に残しておきます。
WordPress側の準備
プラグイン「Application Passwords」のインストール
API経由で投稿できるようにパスワードを発行します。
下記もしくはWordPressの「プラグイン」⇒「新規追加」から「Application Passwords」をインストールしてください。
インストールしたら有効にするのも忘れないでください。
パスワードの発行
次にインストールをしたApplication Passwordsを使ってパスワードを発行します
WordPressの「ユーザー」から「アカウント」を選び下のほうに表示されている
新しいアプリケーションパスワード名を入力して
新しいアプリケーションパスワードを追加をクリックします。
クリックして表示されたパスワードはどこかにコピーして保存しておきましょう。
なお、このパスワードが分かってしまうと誰でもWordPressに投稿できるようになってしまうので取り扱いにはお気をつけください。
投稿するソースコードVBA本体
Sub WordPress_post_test()
status = "draft" //publishで公開 draftで下書き
id = 15 //IDを指定すればその投稿を上書きします。指定しなければ新規で投稿します。
Title = "投稿するタイトル名"
Content = "本文です。HTMLも使えます。"
slug = "" //投稿のスラッグです。
tags = "" //タグですIDで指定します
categories = "" //カテゴリですIDで指定します
postday = "2021-03-18 11:00:00"
featured_media = "" アイキャッチ画像です画像のIDで指定します。
Call WordPress_post(status, id, Title, Content, slug, tags, categories, postday, featured_media)
End Sub
Function WordPress_post(status, id, Title, Content, slug, tags, categories, postday, Optional featured_media = "") As String
url = "https://XXXXXX.com" 'WordPressのトップページのURLを指定します
UserName = "user" 'WordPressのユーザー名を指定します。
pass = "XXXXXXXXXXXX" 'アプリケーションパスワードで発行したパスワードを指定します。
APIURL = url + "/wp-json/wp/v2/posts/" + CStr(id)
'投稿するJSON作成
Dim JsonObject As Object
Set JsonObject = New Dictionary
Dim Header As String
Header = UserName + ":" + pass
Header = "Basic " & EncodeToBase64(Header)
JsonObject.Add "method", method
JsonObject.Add "title", Title
JsonObject.Add "content", Content
JsonObject.Add "status", status
JsonObject.Add "date", postday
JsonObject.Add "categories", categories
If featured_media = "" Then
Else
JsonObject.Add "featured_media", featured_media
End If
JsonObject.Add "muteHttpExceptions", True
Dim objHTTP As Object
Set objHTTP = CreateObject("msxml2.xmlhttp")
objHTTP.Open "POST", APIURL, False
objHTTP.setRequestHeader "Authorization", Header
objHTTP.setRequestHeader "Content-Type", "application/json"
objHTTP.send JsonConverter.ConvertToJson(JsonObject)
Debug.Print objHTTP.responseText
Set Parse = JsonConverter.ParseJson(objHTTP.responseText)
Debug.Print Parse("id")
postId = Parse("id")
postDate = Parse("date")
postPermalink = Parse("Permalink_template")
jsonstr = objHTTP.responseText
WordPress_post = jsonstr
End Function
'https://localbias.work/796
'*-------------------------------------------------------------
'* テキストをBase64でエンコード
'*
'* @param text 変換する値
'* @return Base64フォーマットデータ
'*-------------------------------------------------------------
Public Function EncodeToBase64(ByRef Text As String) As String
' オブジェクトの準備
Dim node As Object
Set node = CreateObject("Msxml2.DOMDocument.3.0").createElement("base64")
' エンコード
node.DataType = "bin.base64"
node.nodeTypedValue = ConvertToBinary(Text)
' 関数で取り除けない改行を削除して返却
EncodeToBase64 = Replace(node.Text, vbLf, "")
End Function
' * 文字列をバイナリデータに変換
' *
' * @param text 変換する値
' * @return バイナリデータ
' *==============================================================
Public Function ConvertToBinary(ByRef Text As String)
' オブジェクトの準備
Dim BinaryStream As Object
Set BinaryStream = CreateObject("ADODB.Stream")
' Streamの設定
With BinaryStream
.Type = 2
.Charset = "us-ascii"
.Open
.WriteText Text
.Position = 0
.Type = 1
.Position = 0
End With
ConvertToBinary = BinaryStream.Read
End Function
投稿サブルーチンVBAでJsonを扱う
RESTAPIを使うにあたってJson形式に変換する必要があります。
めんどくさい変換をかんたんに扱えるライブラリがありますので下記からコードをコピーして
EXCELの標準モジュールに貼り付けます。
投稿のテストをする
下記の3箇所を変更します。それぞれご自身の環境にあわせて書き換えてください。
url = "https://XXXXXX.com" 'WordPressのトップページのURLを指定します
UserName = "user" 'WordPressのユーザー名を指定します。
pass = "XXXXXXXXXXXX" 'アプリケーションパスワードで発行したパスワードを指定します。
「WordPress_post_test()」を実行すると投稿できます。
無事投稿できたら、タイトルや本文の中身を変更して使ってください。
参考にしたサイト
宇宙一わかりやすい?VBA-JSONを使ったJSONパースのしかた
ディスカッション
コメント一覧
まだ、コメントがありません