読者です 読者をやめる 読者になる 読者になる

或阿呆のブログ

Pythonを好んで使っているプログラマです。Ruby,Perl,PowerShell,VBAなどでもたまに書いています。おバカなことが大好きです。

ExcelVBAからはてなブログのAtompubを使って投稿

oneshotlife-tom.hatenadiary.jp

サンプルコードを書いてみました。

Public Function postHatenablog( _
    url As Variant, _
    userId As Variant, _
    password As Variant, _
    title As Variant, _
    category As Variant, _
    body As Variant)
    
    Dim postXml As Variant
    
    Dim objXmlHttp As MSXML2.xmlhttp
    Set objXmlHttp = CreateObject("MSXML2.XMLHTTP")
    Call objXmlHttp.Open("POST", url, False, userId, password)
    
    postXml = postXml & "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCrLf
    postXml = postXml & "<entry xmlns=""http://www.w3.org/2005/Atom""" & vbCrLf
    postXml = postXml & "xmlns:app=""http://www.w3.org/2007/app"">" & vbCrLf
    postXml = postXml & "<title>" & title & "</title>" & vbCrLf
    postXml = postXml & "<author><name>oneshotlife_tom</name></author>" & vbCrLf
    postXml = postXml & "<content type=""text/plain"">" & vbCrLf
    postXml = postXml & body & vbCrLf
    postXml = postXml & "</content>" & vbCrLf
    postXml = postXml & "<updated>" & Format(Now, "yyyy-mm-ddThh:nn:ss") & "</updated>" & vbCrLf
    postXml = postXml & "<category term=""" & category & """ />" & vbCrLf
    postXml = postXml & "<app:control>" & vbCrLf
    postXml = postXml & "<app:draft>no</app:draft>" & vbCrLf
    postXml = postXml & "</app:control>" & vbCrLf
    postXml = postXml & "</entry>" & vbCrLf
   
    Call objXmlHttp.Send(postXml)
    
    If objXmlHttp.Status = 201 Then
        postHatenablog = True
    Else
        postHatenablog = False
    End If
End Function

Public Sub main()
    Dim url, userId, password, title, category, body As Variant
    Dim retVal As Boolean
    Dim objXmlDoc As MSXML2.DOMDocument

    url = "https://blog.hatena.ne.jp/oneshotlife_tom/oneshotlife-tom.hatenadiary.jp/atom/entry"
    userId = "spam"    '自分のユーザーIDを入れてね
    password = "ham"   '自分のパスワードを入れてね
    
    title = "投稿テストです"
    category = "テスト"
    body = "*1" & vbCrLf & _
           "**1-1" & vbCrLf & _
           "投稿テストです"
    retVal = postHatenablog(url, userId, password, title, category, body)
    
    Debug.Print retVal
End Sub

投稿結果はこんな感じになりました。

oneshotlife-tom.hatenadiary.jp