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

2016/03/15 2017/02/26

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 = ""
 For i = LBound(categoryArray) To UBound(categoryArray)
 categoriesTag = categoriesTag & "" & categoryArray(i) & ""
 Next i
 categoriesTag = categoriesTag & ""
 
 contents = "" & _
 "" & _
 "title" & _
 "" & title & "" & _
 "" & _
 "" & _
 "description" & _
 "" & escaped & "" & _
 "" & _
 "" & _
 "categories" & _
 "" & categoriesTag & "" & _
 "" & _
 ""
 
 
 'blogidは1できめうち
 param = "<!--?xml version='1.0' encoding='utf-8'?-->" & vbNewLine & _
 "" & _
 "metaWeblog.newPost" & _
 "" & _
 "1" & _
 "" & mUserName & "" & _
 "" & mPassword & "" & _
 "" & contents & "" & _
 "" & publish & "" & _
 "" & _
 ""

 postToWP = callMethod(param)

End Function

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

'テスト送信
Public Function test() As String
 
 Dim param As String
 
 param = "<!--?xml version='1.0' encoding='utf-8'?-->" & vbNewLine & _
 "" & _
 "wp.getUsersBlogs" & _
 "" & _
 "" & mUserName & "" & _
 "" & mPassword & "" & _
 "" & _
 ""
 
 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つのシートは必須です。

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

20160312172225

こんな感じ。

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

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