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
--------------------------------------------------
--------------------------------------------------