Chromeブックマークマネージャのブックマークを展開し、フォルダ・ファイルにしてエクスポート（10／15）[No53]

前回までお話していた、自作したプログラムの紹介を行った記事（下記リンク）の続きで、今回は１０記事目になります。

Chromeブックマークマネージャのブックマークを展開し、フォルダ・ファイルにしてエクスポート（9／15）[No52]

前回までお話していた、自作したプログラムの紹介を行った記事（下記リンク）の続きで、今回は９記事目になります。 長いファイルなので小分けにして書いていきますが、全て同じファイル「bkm ...

長いファイルなので小分けにして書いていきますが、全て同じファイル「bkmksopen4_02.vbs」に書いて下さい。

ソースコード

Option Explicit

'*********************************************************
Include("D:\Application\BookmarkMakeFile\FunctionsCollection.vbs")
Sub Include(ByVal InputFilePath)
	Dim strFile
	Dim ObjFSO : Set ObjFSO = Wscript.CreateObject("Scripting.FileSystemObject")
	Dim ObjInputFile : Set ObjInputFile = ObjFSO.OpenTextFile(InputFilePath, 1, False, 0)
	ExecuteGlobal ObjInputFile.ReadAll()
	ObjInputFile.Close : Set ObjInputFile = Nothing
	Set ObjFSO = Nothing
End Sub
'*********************************************************
'------------------------------------------------------------------------
'カレントディレクトリのパスを取得する
'------------------------------------------------------------------------
Dim CurDir : CurDir = GetCurDir()
Call MyselfMsgBox01(WScript.scriptname,"001","CurDir",CurDir)
'------------------------------------------------------------------------
'htmlファイルを読み込む
'------------------------------------------------------------------------
Dim inputFilePath : inputFilePath = curDir & "\" & "list.html"
Dim record : record = ReadFile_ADODBStream(inputFilePath)
'------------------------------------------------------------------------
'文字列の置換：「(^<DT><A HREF)～(<DT><H3|$)まで」①_後部が「<DT><H3」であったら削除
'------------------------------------------------------------------------
Dim sKeyA01 : sKeyA01 = "^(<DT><A HREF)"
Dim eKeyA01 : eKeyA01 = "(<DT><H3|$)"
Dim strPattern : strPattern = sKeyA01 & ".*?" & eKeyA01
Dim Matches : Set Matches = ExtractReturnMatches(strPattern,False,record)
Dim MatchesA : Set MatchesA = Matches
Dim MatchesB : Set MatchesB = Matches
Dim mA
Dim mB00
Dim mB01
'------------------------------------------------------------------------
Dim count : count = 0
Dim k
Dim eKeyA02 : eKeyA02 = "<DT><H3"
Dim nelen : nelen = Len(eKeyA02)
Dim nright

For Each mA In MatchesA
	'------------------------------------------------------------------------
	'比較：「<DT><H3」が後部であるか
	'------------------------------------------------------------------------
	nright = Right(mA,nelen)
	If (IsEmpty(mA) = False and count = 0 ) then
		IF (StrComp(nright,eKeyA02) = 0) Then '等しい場合：0、違う場合：1
			k = Left(mA ,Len(mA) - nelen)
		Else
			k = mA
		End If
	End If
	count = count +1
Next
'------------------------------------------------------------------------
Dim sKeyB00
Dim eKeyB00
If (IsEmpty(k) = False) then
	For Each mB00 In MatchesB
		'------------------------------------------------------------------------
		'文字列の置換：【<DT><A HREF=.*?</A>】
		'「(^<DT><A HREF)～(<DT><H3|$)まで」②_抽出したものを正規表現してさらに抽出
		'------------------------------------------------------------------------
		sKeyB00 = "<DT><A HREF="
		eKeyB00 = "</A>"
		
		Dim MatchesB01 : Set MatchesB01 = ExtractReturnMatches(sKeyB00 & ".*?" & eKeyB00,False,mB00)
		'------------------------------------------------------------------------
		For Each mB01 In MatchesB01			
			If (IsEmpty(mB01) = False) then 
				'------------------------------------------------------------------------
				'文字列の置換：【"">.*?</A>】
				'------------------------------------------------------------------------
				Dim sKeyB01 : sKeyB01 = """>"
				Dim eKeyB01 : eKeyB01 = "</A>"
				
				Dim MatchesB02 : Set MatchesB02 = ExtractReturnMatches(sKeyB01 & ".*?" & eKeyB01,False,mB01)
				Dim mfilename : mfilename = MidLeftString(sKeyB01,eKeyB01,MatchesB02.Item(0).Value)
				'------------------------------------------------------------------------
				'文字列の置換：【<DT><A HREF="".*?"" ADD_DATE】
				'------------------------------------------------------------------------
				Dim sKeyB02 : sKeyB02 = "<DT><A HREF="""
				Dim eKeyB02 : eKeyB02 = """ ADD_DATE"
				
				Dim MatchesB03 : Set MatchesB03 = ExtractReturnMatches(sKeyB02 & ".*?" & eKeyB02,False,mB01)
				Dim msiteurl : msiteurl = MidLeftString(sKeyB02,eKeyB02,MatchesB03.Item(0).Value)
				'------------------------------------------------------------------------
				'htmlファイル出力
				'------------------------------------------------------------------------
				On Error Resume Next
					Call CreateShortcutFile(curDir & "\" & mfilename & ".url",msiteurl)
					If Err.Number <> 0 Then
						Err.Clear
						Dim errFlag : errFlag = True
						Do While errFlag = True
							Dim strText
							strText = strText & ""
							strText = strText & "【" & mfilename & "】"
							strText = strText & "のファイル名が原因(文字コード、予約語、既に同じファイル名のファイルがある)でエラーになりました。"
							strText = strText & Chr(13) & Chr(10)
							strText = strText & "ＯＫ(未入力の状態で)、またはキャンセルを押すと終了します。"
														
							mfilename = inputbox(strText)
							strText = ""
							IF mfilename = "" Then
								On Error Goto 0
								WScript.Quit(4097) 'Microsoft VBScript 実行時エラー
							End If
							Call CreateShortcutFile(curDir & "\" & mfilename & ".url",msiteurl)
							errFlag = False
							If Err.Number <> 0 Then
								Err.Clear
								errFlag = True
							End If
						Loop
					End If
				On Error Goto 0
				'------------------------------------------------------------------------
				'整理(少しずつ抽出したところは削除していく)
				'------------------------------------------------------------------------
				record = Mid(record,Len(mB01) + 1)
				'------------------------------------------------------------------------
				'list.htmlの中が空であればhtml,vbsファイル削除
				'------------------------------------------------------------------------
				If (Len(record) = 0 or Len(record) = 1 or Len(record) = 2 or Len(record) = 3) Then
					Call RunDeleteFile02(CurDir)
					WScript.Quit
				End If
			End If
		Next
	Next
End If

Dim strRepAfter01 : strRepAfter01 = k
Dim strRepAfter02 : strRepAfter02 = record
'------------------------------------------------------------------------
'◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇
'------------------------------------------------------------------------
'outputファイルを作成する
'------------------------------------------------------------------------
Dim outputFilePath01 : outputFilePath01 = curDir & "\" & "workfile4_02_01_k.html"
Call WriteFileText_ADODBStream(outputFilePath01,strRepAfter01)
'------------------------------------------------------------------------
'◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇
'------------------------------------------------------------------------
'outputファイルを作成する
'------------------------------------------------------------------------
Dim outputFilePath02 : outputFilePath02 = curDir & "\" & "workfile4_02_02_record.html"
Call WriteFileText_ADODBStream(outputFilePath02,strRepAfter02)
'------------------------------------------------------------------------
'◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇
'------------------------------------------------------------------------
'vbsファイルを実行する
'------------------------------------------------------------------------
Dim vbsFilePath : vbsFilePath = curDir & "\" & "bkmksopen4_03.vbs"
Dim returnErrNo : returnErrNo = RunVBSFile(vbsFilePath)
WScript.Quit(returnErrNo)
'------------------------------------------------------------------------

プログラムについて

今回の「Chromeブックマークマネージャのブックマークを展開し、フォルダ・ファイルにしてエクスポート」の内容はファイル数が多いため、下記リンクの全１５記事に分けてファイルごとに紹介しています。
※この記事の続きは１１記事目になります。

• 01記事目…使い方について
• 02記事目…FunctionsCollection.vbsの作成
• 03記事目…bkmksopen1.vbsの作成
• 04記事目…bkmksopen2.vbsの作成
• 05記事目…bkmksopen3_01.vbsの作成
• 06記事目…bkmksopen3_02.vbsの作成
• 07記事目…bkmksopen3_03.vbsの作成
• 08記事目…bkmksopen3_04.vbsの作成
• 09記事目…bkmksopen4_01.vbsの作成
• 10記事目…bkmksopen4_02.vbsの作成
• 11記事目…bkmksopen4_03.vbsの作成
• 12記事目…bkmksopen4_04.vbsの作成
• 13記事目…bkmksopen4_05.vbsの作成
• 14記事目…bkmksopen4_06.vbsの作成
• 15記事目…bkmksopen4_07.vbsの作成

最後までお付き合いいただきありがとうございます！

この情報が誰かの役にたてれば幸いです。