Last active
August 29, 2015 13:57
-
-
Save uozias/9584563 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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, publish As String) As String | |
Dim param As String | |
Dim contents As String | |
contents = "<struct>" & _ | |
"<member>" & _ | |
"<name>title</name>" & _ | |
"<value><string>" & title & "</string></value>" & _ | |
"</member>" & _ | |
"<member>" & _ | |
"<name>description</name>" & _ | |
"<value><string>" & description & "</string></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 | |
'内部で使う、メソッドコール処理共通部分 | |
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 | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment