自分方位研究所

日々の活動記録

(Excel VBA) はてなブログ記事の管理。1記事分の項目を変数として抜き出す。

 

 1週間ほど前に作成した、Excel シートへの1記事分の出力シートから編集用URLや公開用URL等を取り出します。

--------------------------------------------------

いつものことですが、全体の処理の中から該当するプロシージャのみ切り出しており、前処理は以前紹介していることもあり、省略しております。

tagStrArrayは、必要項目抜き出しのキーとなるタグを配列変数化したものです。

全部の項目を一つのプロシージャで書いてしまうと、長くなりすぎるので、1変数1プロシージャに分割して処理しています。
あと、アイキャッチサムネイル画像のURLと、画像説明を新たに加えました。

投稿日は、日付と時刻を分割し、さらにExcelシートに貼りつけたときにならべ替えに使用できるように、(シリアル値として使える)日付 + 時刻 も作成しています。

全体に、もし検索して見つからないタグが発生したときは「★」印を表示して継続処理するようにしています。

Sub s06_03_PickUpItem2()

Dim i As Integer
Dim hitRng As Range
Dim textAll As String

Call s06_03_10_Reset


For i = 0 To UBound(tagStrArray)   '0~7
    Set hitRng = outputSheet.Cells.Find _
                (What:=tagStrArray(i), LookIn:=xlValues, LookAt:=xlPart)
    If Not hitRng Is Nothing Then
        'textAll = CStr(hitRng.Value)  'セル内文字全体を取得
        'Debug.Print VarType(textAll)    '→ 8 (String)
        'Debug.Print "★case=" & i
        Select Case i
            Case 0  '(9行目)編集用ページURLと記事題名
                Call s06_03_00(hitRng)  '(13行目)記事本文先頭 (サマリ)
            Case 1
                Call s06_03_01(hitRng)  '(9行目)編集用URLと記事題名,記事ID
            Case 2
                Call s06_03_02(hitRng)  '(50行目)作成者
            Case 3
                Call s06_03_03(hitRng)  '(51行目)カテゴリ
            Case 4
                Call s06_03_04(hitRng)  '(55行目)コメント数
            Case 5
                Call s06_03_05(hitRng)  '(57行目)投稿日時
            Case 6
                Call s06_03_06(hitRng)  '(60行目)公開用記事URL
            Case 7
                Call s06_03_07(hitRng)  'アイキャッチ画像
        End Select
'    Else
'        Debug.Print "i=" & i & "  見つかりません→" & tagStrArray(i)
'        MsgBox "i=" & i & "  見つかりません→" & tagStrArray(i)
'        Stop
'        → 見つからないときは、★印が付くようにした。
    End If
Next i

Call DisplayStatusBar(4)

End Sub

--------------------------------------------------

Sub s06_03_10_Reset()

'各項目の変数をリセットする。
'次の記事に影響を与えないように。

editURL = "★" 'As String   '記事編集用URL
editID = "★" 'As String    '記事ID = Right(editURL, numLen3 - numInStr3 - 5)
entryTitle = "★" 'As String    '記事題名
entrySummary = "★" 'As String  '記事サマリ
summaryLen = 0 'As Integer   'サマリ文字数 '= Len(entrySummary)
blogAuthor = "★" 'As String    'はてなID
blogComment = 0 'As Integer  'コメント数
dataLocal = "★" 'As String    '投稿日時
entryURL = "★" 'As String  '記事公開用URL
Erase blogCategoryAry()    'カテゴリ配列
eyeImgAlt = "★" '
eyeImgURL = "★" '

dataLocalDay = "" 'As Variant    '= NUKIDASImid(dataLocal, "", "日")
dataLocalTime = "" 'As Variant     '= NUKIDASImid(dataLocal, "日", "")
dateAndTime = "" 'As Variant '= DateValue(dataLocalDay) + TimeValue(dataLocalTime)


End Sub

--------------------------------------------------

Sub s06_03_00(hitRng) '(9行目)編集用URLと記事題名,記事ID

'<a class="entry-title js-search-entry-title"
'href="https://blog.hatena.ne.jp/hatenaID.hateblo.jp/edit?entry=12345678901234567">
'記事題名 </a>

Dim textAll As String
    textAll = hitRng.Value

    entryTitle = NUKIDASImid(textAll, ">", "</a>")
    Debug.Print "entryTitle="; entryTitle
    
    editURL = NUKIDASImid(textAll, "href=""", """>")
    Debug.Print "editURL="; editURL
    
    editID = NUKIDASImid(editURL, "entry=", "")
    Debug.Print "editID="; editID
          

End Sub
'--------------------------------------------------

Sub s06_03_01(hitRng) '(13行目)記事本文先頭 (サマリ)

'→このセルの次の行全部丸ごとサマリ
'<div class="entry-body-summary js-search-entry-body">

    entrySummary = hitRng.Offset(1, 0).Value
    Debug.Print entrySummary
    summaryLen = Len(entrySummary)
    Debug.Print summaryLen

    If Trim(entrySummary) = "</div>" Then
        summaryLen = ""
        summaryLen = 0
    End If

End Sub
'--------------------------------------------------

Sub s06_03_02(hitRng) '(50行目)作成者

'<td class="td-blog-author">はてなID</td>
Dim textAll As String
    textAll = hitRng.Value

    blogAuthor = NUKIDASImid(textAll, CStr(tagStrArray(2)), "</td>")
    Debug.Print blogAuthor


End Sub
'--------------------------------------------------

Sub s06_03_03(hitRng) 'カテゴリ

'<td class="td-blog-category">
'<span class="blog-category-name">Excel VBA</span>
'<span class="blog-category-name">ブログ運営</span>
'</td>


Dim lp As Byte
Dim tmpCat As String
'    Dim blogCategoryAry() As String
    lp = 0
    Do
        tmpCat = hitRng.Offset(lp + 1, 0).Value
        If InStr(tmpCat, "blog-category-name") = 0 Then
            Exit Do
        End If
        ReDim Preserve blogCategoryAry(lp)
        blogCategoryAry(lp) = NUKIDASImid(tmpCat, "blog-category-name"">", "</span>")
        Debug.Print blogCategoryAry(lp)
    
        lp = lp + 1
    Loop
    blogCategoryCount = lp  '登録カテゴリ数
End Sub
'--------------------------------------------------

Sub s06_03_04(hitRng) 'コメント数

'<td class="td-blog-comment">0</td>

Dim textAll As String
    textAll = hitRng.Value

    blogComment = NUKIDASImid(textAll, CStr(tagStrArray(4)), "</td>")
    Debug.Print blogComment

End Sub
'--------------------------------------------------

Sub s06_03_05(hitRng) '投稿日時

'<time class="time" datetime="2020-06-12T14:15:47.000Z"
'data-epoch="1591971347000" data-local="">?2020?年?6?月?12?日? ?23?:?15?:?47</time>

Dim textAll As String
    textAll = hitRng.Value

Dim deltxt
    dataLocal = NUKIDASImid(textAll, "data-local="""">", "</time>")
    dataLocal = Replace(dataLocal, "?", "")
    'Debug.Print dataLocal
    'Debug.Print Len(dataLocal)
    'Debug.Print "【" & Left(dataLocal, 1) & "】"
    deltxt = Left(dataLocal, 1)
    dataLocal = Replace(dataLocal, deltxt, "")
    Debug.Print dataLocal
    dataLocalDay = NUKIDASImid(dataLocal, "", "日") & "日"
    Debug.Print dataLocalDay    '2016年4月26日
    dataLocalTime = Trim(NUKIDASImid(dataLocal, "日", ""))
    Debug.Print dataLocalTime   '19:57:48

    dateAndTime = DateValue(dataLocalDay) + TimeValue(dataLocalTime)

End Sub
'--------------------------------------------------

Sub s06_03_06(hitRng) '公開用記事URL

'<a href="https://www.mypath-as-variant.com/entry/2020/06/12/231547" target="_blank">
'<i title="記事を見る" class="blogicon-external tipsy-southeast"></i></a>

'<a href="★URL★" target="_blank">

Dim textAll As String
    textAll = hitRng.Value

    entryURL = NUKIDASImid(textAll, "href=""", """ target=""_blank"">")
    Debug.Print entryURL

End Sub
'--------------------------------------------------

Sub s06_03_07(hitRng)  'アイキャッチ画像

'<img alt="アイキャッチ画像" src="https://cdn.image.st-hatena.com/
'image/square/ddfh~~/backend=
'imagemagick;height=60;version=1;width=60/https~~-hatena.com
'%~%~%~%2FhatenaID%%.jpg">

'eyeImgAlt As String 'アイキャッチ画像説明
'eyeImgURL As String 'アイキャッチ画像URL

Dim textAll As String
    textAll = hitRng.Value

eyeImgAlt = NUKIDASImid(textAll, "<img alt=""", """ src=""https://")
eyeImgURL = NUKIDASImid(textAll, "src=""", """>")


End Sub

--------------------------------------------------

 

--------------------------------------------------