ぼくらの勉強

ぼくらのための勉強をしていきます。

VBAでセルの内容をWordPressに自動投稿する(複数記事一括可)

      2016/03/28

VBA

スポンサーリンク

コード内容

WordPressのXMLインポート機能を使い、エクセルに入力してある内容(記事タイトル、本文、カテゴリー等)にしたがってWordpressへの自動一括記事投稿を行うマクロ。セルに数百記事分の情報を入れておいて一括で投稿できたりします。便利だと思います。

まずコードから紹介します。

標準モジュール部

標準モジュールに「MainModule」を追加。


Public dataSheet1 As dataSheet
Public resultSheet1 As ResultSheet
Public sender As WPSender

Public Sub Auto_load()
 Set dataSheet1 = New dataSheet
 dataSheet1.init

 Set resultSheet1 = New ResultSheet
 resultSheet1.init

 Set sender = New WPSender

 sender.init (dataSheet1.getURL())

End Sub

Public Sub send()

 Auto_load

 resultSheet1.reset

 Dim response As String

 Do
 sender.setUser dataSheet1.getUserName(), dataSheet1.getPassword()
 response = sender.postToWP(dataSheet1.getTitle(), dataSheet1.getContent(), dataSheet1.GetCategories(), dataSheet1.getPublishSetting())
 resultSheet1.writeResult (response)
 Loop While dataSheet1.nextLine()

 MsgBox "データ投稿完了"

End Sub

Public Sub test()
 Auto_load

 Dim response As String
 response = sender.test()

 resultSheet1.writeResult (response)
End Sub

クラスモジュール部

クラスモジュールに「DataSheet」、「ResultSheet」、「WPSender」を追加。

Datasheet

Private mSheet As Worksheet
Private startRowNum As Long
Private endRowNUm As Long
Private rowNumNow As Long

Public Sub init()

 Set mSheet = Application.Worksheets("data")

 startRowNum = 3

 endRowNUm = mSheet.Range("A1").End(xlDown).Row
 rowNumNow = startRowNum

End Sub

Public Function nextLine() As Boolean
 Dim result As Boolean
 result = True

 rowNumNow = rowNumNow + 1
 If mSheet.Cells(rowNumNow, 1) = "" Then
 result = False
 End If

 nextLine = result
End Function

Public Function getURL() As String

 getURL = mSheet.Cells(rowNumNow, 1).Value

End Function

Public Function getUserName() As String

 getUserName = mSheet.Cells(rowNumNow, 2).Value

End Function

Public Function getPassword() As String

 getPassword = mSheet.Cells(rowNumNow, 3).Value

End Function

Public Function getTitle() As String

 getTitle = mSheet.Cells(rowNumNow, 4).Value

End Function

Public Function getContent() As String

 getContent = mSheet.Cells(rowNumNow, 5).Value

End Function

Public Function GetCategories() As String

 GetCategories = mSheet.Cells(rowNumNow, 6).Value
End Function

Public Function getPublishSetting() As String

 If mSheet.Cells(rowNumNow, 7).Value = "公開" Then
 getPublishSetting = 1
 Else
 getPublishSetting = 0
 End If

End Function

ResultSheet

Dim mSheet As Worksheet
Dim endRowNUm As Long
Dim nextRowNum As Long

Public Sub init()

 Set mSheet = Application.Worksheets("result")
 startRowNum = 1
 nextRowNum = startRowNum

End Sub

Public Sub writeResult(response As String)

 mSheet.Range("A" & nextRowNum).Value = response
 nextRowNum = nextRowNum + 1
 mSheet.Activate
End Sub

Public Sub reset()
 mSheet.Range("A1").Value = response
 endRowNUm = mSheet.Range("A1").End(xlDown).Row

 mSheet.Range("A1:A" & endRowNUm).Value = ""
End Sub

WPSender

Dim xhr As XMLHTTP

Dim mUserName As String
Dim mPassword As String
Dim mURL As String

Public Sub init(url As String)
 
 mURL = url & "/xmlrpc.php"
 
End Sub

'ユーザとパスワードをセット
Public Sub setUser(userName As String, password As String)

 mUserName = userName
 mPassword = password
 
End Sub

'wordpressに投稿
Public Function postToWP(title As String, description As String, categories As String, publish As String) As String
 Dim param As String
 Dim contents As String, categoriesTag As String, escaped As String
 Dim categoryArray As Variant
 Dim i As Integer
 escaped = escapeXML(description)
 
 
 categoryArray = Split(categories, ",")
 categoriesTag = "<array><data>"
 For i = LBound(categoryArray) To UBound(categoryArray)
 categoriesTag = categoriesTag & "<value><string>" & categoryArray(i) & "</string></value>"
 Next i
 categoriesTag = categoriesTag & "</data></array>"
 
 contents = "<struct>" & _
 "<member>" & _
 "<name>title</name>" & _
 "<value><string>" & title & "</string></value>" & _
 "</member>" & _
 "<member>" & _
 "<name>description</name>" & _
 "<value><string>" & escaped & "</string></value>" & _
 "</member>" & _
 "<member>" & _
 "<name>categories</name>" & _
 "<value>" & categoriesTag & "</value>" & _
 "</member>" & _
 "</struct>"
 
 
 'blogidは1できめうち
 param = "<?xml version='1.0' encoding='utf-8'?>" & vbNewLine & _
 "<methodCall>" & _
 "<methodName>metaWeblog.newPost</methodName>" & _
 "<params>" & _
 "<param><value><int>1</int></value></param>" & _
 "<param><value><string>" & mUserName & "</string></value></param>" & _
 "<param><value><string>" & mPassword & "</string></value></param>" & _
 "<param><value>" & contents & "</value></param>" & _
 "<param><value><boolean>" & publish & "</boolean></value></param>" & _
 "</params>" & _
 "</methodCall>"

 postToWP = callMethod(param)

End Function

'HTMLエスケープ
Public Function escapeXML(Text As String) As String
 Dim result As String
 result = Replace(Text, "&", "&amp;")
 result = Replace(result, "<", "&lt;")
 result = Replace(result, ">", "&gt;")
 result = Replace(result, """", "&quot;")
 result = Replace(result, "'", "&apos;")
 escapeXML = result
End Function

'テスト送信
Public Function test() As String
 
 Dim param As String
 
 param = "<?xml version='1.0' encoding='utf-8'?>" & vbNewLine & _
 "<methodCall>" & _
 "<methodName>wp.getUsersBlogs</methodName>" & _
 "<params>" & _
 "<param><value><string>" & mUserName & "</string></value></param>" & _
 "<param><value><string>" & mPassword & "</string></value></param>" & _
 "</params>" & _
 "</methodCall>"
 
 test = callMethod(param)
End Function

'内部で使う、メソッドコール処理共通部分
Private Function callMethod(param As String)

 
 Dim response As String
 
 Set xhr = New XMLHTTP
 xhr.Open "POST", mURL, False
 xhr.setRequestHeader "Method", "POST " & mURL & " HTTP/1.1"
 xhr.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
 

 On Error GoTo sendError
 xhr.send (param)

 response = xhr.responseText
 
 
 Set xhr = Nothing

 
 callMethod = response
 
 Exit Function
 

sendError:
 MsgBox "送信エラー"
 callMethod = "error"

End Function

 

スポンサーリンク

 

コードの説明

まずシートの作成を行う必要があります。「data」「result」の2つのシートは必須です。

 

20160312171543

 

「data」のシートには記事タイトルとか本文とか投稿する記事情報を入れ込みます。

 

20160312172225

こんな感じ。

3行目以降のA列~G列に投稿する記事それぞれの内容を入力。(1,2行目は無視して3行目からデータを読み出す設定になっています)

A列 URL 記事を投稿するWordpressサイトのURL(トップページ)を入力
B列 ユーザー名 管理者ユーザー名を入力
C列 パスワード パスワードを入力
D列 タイトル 投稿する記事のタイトルを入力
E列 本文 投稿する記事の本文を入力
F列 カテゴリ 投稿する記事のカテゴリーを入力
G列 公開設定 記事を公開状態で投稿する場合は「公開」
下書き状態で投稿する場合は「下書き」

さっきの例だと3,4行目の2記事分しか情報を書いていませんが、もちろんそれ以降にも記事をズラーっと書き足していくことができます。空欄行になり次第終了。

何記事まで一括でインポート(投稿)できるかはPCやサーバーの環境によるのでなんとも言えませんが、ぼく個人の経験では300記事くらい一気に投稿してても特に不具合が出たことはありませんでした。

「result」の方は投稿結果を出力するためのシートなので特にいじる必要は無し。

投稿したいデータが決まったらマクロの「send」を実行すればOK。

あとは自動でセルに入力してある内容をWordPressに投稿してくれます。

完了したらメッセージが出るのでそれまでは閉じたりしないように。

データ投稿完了メッセージ

注意書き

このマクロを使ったことで何か損害や不利益を被ったとしてもこちらで責任は負いかねます。そこは利用者個人の責任で何卒お願いしたく候。

あと個別のサポートとかもできませぬ。あしからず。

参照設定

VBAWordpress投稿参照設定

・Visual Basic For Applications
・Microsoft Excel 15.0 Object Library
・OLE Automation
・Microsoft Office 15.0 Object Library
・Microsoft XML, v.3.0

5つにチェック入れといてください。

VBAのIE操作を覚えるのに一番良いと思う本(ぼくはこれで覚えました)

 - VBA