その他

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

スポンサーリンク

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

no image
Chromeブックマークマネージャのブックマークを展開し、フォルダ・ファイルにしてエクスポート（1／15）[No44]
前回の記事で記載したようにChromeでサイト管理しています。登録したブックマークをファイル化・フォルダ化して出力したかったのですが、今ある機能では「bookmarks_2020_0 ...

このプログラム用にまとめたライブラリのような関数集「FunctionsCollection.vbs」を作成します。保存時は文字コードをANSI（メモ帳の場合）、S-JIS（サクラエディタの場合）にしましょう。

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

ソースコード


Option Explicit

'*********************************************************
'用途:ファイルを読み込み、値を返す
'引数:filePath(読み込みするファイルの場所)
'戻り値:読み込みをした文字列
'*********************************************************
Function ReadFile_ScriptingFileSystemObject(ByVal filePath)
	Const TristateFalse = .0
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	Dim ObjInputFile : Set ObjInputFile = ObjFSO.OpenTextFile(filePath,,,TristateFalse) 'OpenTextFile(filename,[iomode,[create,[format]]])
	Dim tempString : tempString = ObjInputFile.ReadAll
	ObjInputFile.Close : Set ObjInputFile = Nothing
	Set ObjFSO = Nothing
	
	ReadFile_ScriptingFileSystemObject = tempString
End Function

'*********************************************************
'用途:ファイルを読み込み（テキスト、UTF-8、全行）、値を返す
'引数:filePath(読み込みするファイルの場所)
'戻り値:読み込みをした文字列
'*********************************************************
Function ReadFile_ADODBStream(ByVal filePath)

	Dim inStream : Set inStream = CreateObject("ADODB.Stream")
	With inStream
		.charset = "UTF-8"
		.type = 2
		.open
		.LoadFromFile filePath
	End With

	Dim tempString : tempString = inStream.ReadText(-1) 'adReadAll
	inStream.Close : Set inStream = Nothing
	
	ReadFile_ADODBStream = tempString
End Function

'*********************************************************
'用途:ファイルを作成する
'引数:filePath(作成するファイルの場所)
'*********************************************************
Sub CreateFile(ByVal filePath)
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	Dim ObjCreateFile : Set ObjCreateFile = ObjFSO.CreateTextFile(filePath,True,True) 'CreateTextFile(filename,[overwrite,[unicode]])
	ObjCreateFile.Close : Set ObjCreateFile = Nothing
	Set ObjFSO = Nothing
End Sub

'*********************************************************
'用途:ファイルに書き込み（テキスト、ASCII 形式、上書き）
'引数:filePath(書き込みするファイルの場所),strText(書き込みする文字列)
'*********************************************************
Sub WriteFileText_ScriptingFileSystemObject(ByVal filePath,ByVal strText)
	Dim Obj01 : Set Obj01 = WScript.CreateObject("Scripting.FileSystemObject") 
	Dim Obj02 : Set Obj02 = Obj01.OpenTextFile(filePath,8,True)
	Obj02.WriteLine(strText)
	Obj02.Close : Set Obj02 = Nothing
	Set Obj01 = Nothing
End Sub

'*********************************************************
'用途:ファイルに書き込み（テキスト、UTF-8、上書き）
'引数:filePath(書き込みするファイルの場所),strText(書き込みする文字列)
'*********************************************************
Sub WriteFileText_ADODBStream(ByVal filePath,ByVal strText)
	Dim outStream : Set outStream = CreateObject("ADODB.Stream")
	With outStream
		.charset = "UTF-8"
		.type = 2
		.Open
		.WriteText strText, 0
		.SaveToFile filePath, 2
	End With
	
	outStream.Close : Set outStream = Nothing
End Sub

'*********************************************************
'用途:HTMLファイルを作成する
'引数:filePath(作成するファイルの場所)、msiteurl()
'*********************************************************
Sub CreateShortcutFile(ByVal filePath, ByVal msiteurl)
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	If ObjFSO.FileExists(filePath) = True Then
		Err.Raise 4097 'Microsoft VBScript 実行時エラー
	Else
		Dim objWsh : Set objWsh = CreateObject("WScript.Shell")
		Dim objCreateShortcut : Set objCreateShortcut = objWsh.CreateShortcut(filePath)
		objCreateShortcut.TargetPath = msiteurl
		objCreateShortcut.save
		Set objWsh = Nothing
		Set objCreateShortcut = Nothing
	End If
	
	Set ObjFSO = Nothing
End Sub

'*********************************************************
'用途:RegExp(正規表現)で文字列を抽出する
'引数:strPattern(正規表現に用いるパターン)、bMultiLine（）、target(抽出対象の文字列)
'戻り値:抽出した文字列のMatches
'*********************************************************
Function ExtractReturnMatches(ByVal strPattern, ByVal bMultiLine, ByVal target)
	Dim regEx : Set regEx = New RegExp
	With regEx
		.Pattern = strPattern
		.IgnoreCase = True
		.Global = True
		.MultiLine = bMultiLine
	End With
	
	Dim Matches : Set Matches = regEx.Execute(target)
	Set regEx = Nothing
	
	Set ExtractReturnMatches = Matches
End Function

'*********************************************************
'用途:RegExp(正規表現)で文字列を抽出して置換する
'引数:strPattern(正規表現に用いるパターン)、bMultiLine（）、strRepBefore(抽出対象の文字列)、strRepWord(置換文字列)
'戻り値:抽出した文字列を置換した後の文字列
'*********************************************************
Function ExtractReturnString(ByVal strPattern, ByVal bMultiLine, ByVal strRepBefore, ByVal strRepWord)
	Dim regEx : Set regEx = New RegExp
	With regEx
		.Pattern = strPattern
		.IgnoreCase = True
		.Global = True
		.MultiLine = bMultiLine
	End With
	
	Dim strRepAfter : strRepAfter = regEx.Replace(strRepBefore, strRepWord)
	Set regEx = Nothing
	
	ExtractReturnString = strRepAfter
End Function

'*********************************************************
'用途:フォルダを作成する（存在チェックでなければ）
'引数:folderPath(作成するフォルダの場所)
'*********************************************************
Sub CreateFolder(ByVal folderPath)
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If ObjFSO.FolderExists(folderPath) = True Then
		Dim strText : strText = "フォルダ「" & folderPath & "」は既にあります。削除してから実行して下さい" & "→" & WScript.scriptfullname
		WScript.Echo strText
		WScript.Quit
	Else
		ObjFSO.CreateFolder(folderPath)
		If Err.Number = 0 Then
		End If
	End If
	
	Set ObjFSO = Nothing
End Sub

'*********************************************************
'用途:フォルダの存在チェックをする
'引数:folderPath(フォルダの場所)
'*********************************************************
Sub CheckFolderExists(ByVal folderPath)
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If ObjFSO.FolderExists(folderPath) = True Then
		Dim strText : strText = "フォルダ「" & folderPath & "」は既にあります。削除してから実行して下さい"
		WScript.Echo strText
		WScript.Quit
	End If
	
	Set ObjFSO = Nothing
End Sub

'*********************************************************
'用途:ファイルの存在を存在チェックする
'引数:filePath(ファイルの場所)
'*********************************************************
Sub CheckFileExists(ByVal filePath)
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If ObjFSO.FileExists(filePath) = True Then
	Else
		Dim strText : strText = "ファイル「" & filePath & "」がありません。"
		WScript.Echo strText
		WScript.Quit
	End If
	
	Set ObjFSO = Nothing
End Sub

スポンサーリンク


'WScript.scriptfullname
'WScript.scriptname
'*********************************************************
'用途:メッセージボックスその１
'引数:fileName()、serialNo()、variableName()、variable()
'*********************************************************
Sub MyselfMsgBox01(ByVal fileName,ByVal serialNo,ByVal variableName,ByVal variable)
	'調査用
	If 1 = 0 then
		Dim strText
		strText = strText & ""
		strText = strText & "【" & fileName & "】"
		strText = strText & "【" & serialNo & "】"
		strText = strText & Chr(13) & Chr(10)
		strText = strText & "【" & variableName & "：】"
		strText = strText & Chr(13) & Chr(10)
		strText = strText & "【" & variable & "】"
		
		MsgBox strText
	End If
End Sub

'WScript.scriptfullname
'WScript.scriptname
'*********************************************************
'用途:メッセージボックスその２
'引数:fileName()、serialNo()、variableName()、variable()
'*********************************************************
Sub MyselfMsgBox02(ByVal fileName,ByVal serialNo,ByVal variableName,ByVal variable)
	'調査用
	If 1 = 1 then
		Dim strText
		strText = strText & ""
		strText = strText & "【" & fileName & "】"
		strText = strText & "【" & serialNo & "】"
		strText = strText & Chr(13) & Chr(10)
		strText = strText & "【Len：" & Len(variable) & "】"
		strText = strText & Chr(13) & Chr(10)
		strText = strText & "【" & variableName & "：】"
		strText = strText & Chr(13) & Chr(10)
		strText = strText & "【" & variable & "】"
		
		MsgBox strText
	End If
End Sub

'*********************************************************
'用途:ログファイル用
'*********************************************************
Sub WriteLogText(ByVal fileName,ByVal serialNo,ByVal variableName,ByVal variable)
	
	'調査用
	If 1 = 1 then
		Dim Obj01 : Set Obj01 = WScript.CreateObject("Scripting.FileSystemObject") 
		
		Dim strText
		strText = strText & Time  & "→"
		strText = strText & "【" & fileName & "】"
		strText = strText & "【" & serialNo & "】"
		strText = strText & Chr(13) & Chr(10)
		strText = strText & "【Len：" & Len(variable) & "】"
		strText = strText & Chr(13) & Chr(10)
		strText = strText & "【" & variableName & "：】"
		strText = strText & Chr(13) & Chr(10)
		strText = strText & "【" & variable & "】"
		
		Dim Obj02 : Set Obj02 = Obj01.OpenTextFile("D:\Application\BookmarkMakeFile" & "\" & "log.txt",8,True)
		Obj02.WriteLine(strText)
		Obj02.Close : Set Obj02 = Nothing
		Set Obj01 = Nothing
	End If
End Sub

'*********************************************************
'用途:カレントディレクトリのパスを取得する
'*********************************************************
Function GetCurDir()
	'FileSystemObject オブジェクト	: https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/filesystemobject-object
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	GetCurDir               = ObjFSO.getParentFolderName(WScript.ScriptFullName)
End Function

'*********************************************************
'用途:vbsファイルを実行する
'*********************************************************
Function RunVBSFile(ByVal filePath)
	Dim objWsh : Set objWsh = WScript.CreateObject("WScript.Shell")
	Dim returnErrNo : returnErrNo =  objWsh.Run(filePath,,True)
	Set objWsh = Nothing
	
	RunVBSFile = returnErrNo
End Function

'*********************************************************
'用途:メッセージボックス。「いいえ」を選択したら終了する。
'*********************************************************
Sub DisplaySelectionScreen(ByVal strText, ByVal style, ByVal title, ByVal folderPath)
	Dim Response : Response = MsgBox(strText, style, title)
	If Response = vbYes Then
	Else
		DisplaySelectionScreen_Delete(folderPath)
		WScript.Quit
	End If
End Sub

'*********************************************************
'用途:メッセージボックス。「はい」を選択したら削除する。
'*********************************************************
Sub DisplaySelectionScreen_Delete(ByVal folderPath)
	Dim strText
		strText = strText & ""
		strText = strText & "【" & folderPath & "】"
		strText = strText & Chr(13) & Chr(10)
		strText = strText & "Are you sure you want to delete the work files in the folder?"
		strText = strText & Chr(13) & Chr(10)

	Dim style : style = vbYesNo + vbInformation + vbDefaultButton1
	Dim title : title = "Delete Confirmation"
	
	Dim Response : Response = MsgBox(strText, style, title)
	
	If Response = vbYes Then
		Call RunDeleteFile01(folderPath)
	Else
		WScript.Quit
	End If
End Sub

'*********************************************************
'用途:文字列の先頭と末尾のキーボードを取り除く
'*********************************************************
Function MidLeftString(ByVal sKey, ByVal eKey, ByVal target)
	Dim partMid  : partMid  = Mid(target, Len(sKey) + 1)
	Dim partLeft : partLeft = Left(partMid, Len(partMid) - Len(eKey))
	MidLeftString = partLeft
End Function

'*********************************************************
'用途:指定したフォルダにあるファイルを削除する
'*********************************************************
Sub RunDeleteFile01(ByVal folderPath)
	'調査用
	If 1 = 1 then
		Dim ObjFSO : Set ObjFSO = CreateObject("Scripting.FileSystemObject")
		With ObjFSO
			.DeleteFile folderPath & "\" & "workfile1.html" ,True
			.DeleteFile folderPath & "\" & "workfile2.html" ,True
			.DeleteFile folderPath & "\" & "workfile3_01.html" ,True
			.DeleteFile folderPath & "\" & "workfile3_02.html" ,True
			.DeleteFile folderPath & "\" & "workfile3_03_01.html" ,True
			.DeleteFile folderPath & "\" & "workfile3_03_02.html" ,True
		End With
		Set ObjFSO = Nothing
	End If
End Sub

'*********************************************************
'用途:指定したフォルダにあるファイルを削除する
'*********************************************************
Sub RunDeleteFile02(ByVal folderPath)
	'調査用
	If 1 = 1 then
		Dim ObjFSO : Set ObjFSO = CreateObject("Scripting.FileSystemObject")
		With ObjFSO
			.DeleteFile folderPath & "\" & "list.html" ,True
			.DeleteFile folderPath & "\" & "bkmksopen4_01.vbs" ,True
			.DeleteFile folderPath & "\" & "bkmksopen4_02.vbs" ,True
			.DeleteFile folderPath & "\" & "bkmksopen4_03.vbs" ,True
			.DeleteFile folderPath & "\" & "bkmksopen4_04.vbs" ,True
			.DeleteFile folderPath & "\" & "bkmksopen4_05.vbs" ,True
			.DeleteFile folderPath & "\" & "bkmksopen4_06.vbs" ,True
			.DeleteFile folderPath & "\" & "bkmksopen4_07.vbs" ,True
		End With
		Set ObjFSO = Nothing
	End If
End Sub

'*********************************************************
'用途:指定したフォルダにあるファイルを削除する
'*********************************************************
Sub RunDeleteFile03(ByVal folderPath)
	'調査用
	If 1 = 1 then
		Dim ObjFSO : Set ObjFSO = CreateObject("Scripting.FileSystemObject")
		With ObjFSO
			.DeleteFile folderPath & "\" & "workfile4_02_01_k.html" 			,True
			.DeleteFile folderPath & "\" & "workfile4_02_02_record.html" 		,True
			.DeleteFile folderPath & "\" & "workfile4_03_01_k.html" 			,True
			.DeleteFile folderPath & "\" & "workfile4_03_02_record.html" 		,True
			.DeleteFile folderPath & "\" & "workfile4_04_mfolname.html" 		,True
			.DeleteFile folderPath & "\" & "workfile4_05_joinPattern.html" 		,True
			.DeleteFile folderPath & "\" & "workfile4_06_01.html" 				,True
			.DeleteFile folderPath & "\" & "workfile4_06_02_notitlelist.html" 	,True
		End With
		Set ObjFSO = Nothing
	End If
End Sub

スポンサーリンク


'*********************************************************
'用途:ファイルをコピーする(bookmark)
'*********************************************************
Sub RunCopyFile_bookmark(ByVal folderPath)
	Dim ObjFSO : Set ObjFSO = CreateObject("Scripting.FileSystemObject")
	With ObjFSO
		.CopyFile folderPath & "\" & "workfile3_03_01.html"	, folderPath & "\" & "bookmark" & "\" & "list.html"

		.CopyFile "D:\Application\BookmarkMakeFile" & "\" & "bkmksopen4_01.vbs", folderPath & "\"
		.CopyFile "D:\Application\BookmarkMakeFile" & "\" & "bkmksopen4_02.vbs", folderPath & "\"
		.CopyFile "D:\Application\BookmarkMakeFile" & "\" & "bkmksopen4_03.vbs", folderPath & "\"
		.CopyFile "D:\Application\BookmarkMakeFile" & "\" & "bkmksopen4_04.vbs", folderPath & "\"
		.CopyFile "D:\Application\BookmarkMakeFile" & "\" & "bkmksopen4_05.vbs", folderPath & "\"
		.CopyFile "D:\Application\BookmarkMakeFile" & "\" & "bkmksopen4_06.vbs", folderPath & "\"
		.CopyFile "D:\Application\BookmarkMakeFile" & "\" & "bkmksopen4_07.vbs", folderPath & "\"
	End With
	Set ObjFSO = Nothing
End Sub

'*********************************************************
'用途:ファイルをコピーする(otherbookmark)
'*********************************************************
Sub RunCopyFile_otherbookmark(ByVal folderPath)
	Dim ObjFSO : Set ObjFSO = CreateObject("Scripting.FileSystemObject")
	With ObjFSO
		.CopyFile folderPath & "\" & "workfile3_03_02.html"	, folderPath & "\" & "otherbookmark" & "\" & "list.html"
		.CopyFile folderPath & "\" & "bkmksopen4_01.vbs"	, folderPath & "\" & "otherbookmark" & "\" & "bkmksopen4_01.vbs"
		.CopyFile folderPath & "\" & "bkmksopen4_02.vbs"	, folderPath & "\" & "otherbookmark" & "\" & "bkmksopen4_02.vbs"
		.CopyFile folderPath & "\" & "bkmksopen4_03.vbs"	, folderPath & "\" & "otherbookmark" & "\" & "bkmksopen4_03.vbs"
		.CopyFile folderPath & "\" & "bkmksopen4_04.vbs"	, folderPath & "\" & "otherbookmark" & "\" & "bkmksopen4_04.vbs"
		.CopyFile folderPath & "\" & "bkmksopen4_05.vbs"	, folderPath & "\" & "otherbookmark" & "\" & "bkmksopen4_05.vbs"
		.CopyFile folderPath & "\" & "bkmksopen4_06.vbs"	, folderPath & "\" & "otherbookmark" & "\" & "bkmksopen4_06.vbs"
		.CopyFile folderPath & "\" & "bkmksopen4_07.vbs"	, folderPath & "\" & "otherbookmark" & "\" & "bkmksopen4_07.vbs"
	End With
	Set ObjFSO = Nothing
End Sub

'*********************************************************
'用途:ファイルをコピーする(各々のファイル)
'*********************************************************
Sub RunCopyFile_strFolder(ByVal folderPath)
	Dim ObjFSO : Set ObjFSO = CreateObject("Scripting.FileSystemObject")
	With ObjFSO
		.CopyFile "C:\Project\Program\No00010\BookmarkMakeFile" & "\" & "bkmksopen4_01.vbs", folderPath & "\"
		.CopyFile "C:\Project\Program\No00010\BookmarkMakeFile" & "\" & "bkmksopen4_02.vbs", folderPath & "\"
		.CopyFile "C:\Project\Program\No00010\BookmarkMakeFile" & "\" & "bkmksopen4_03.vbs", folderPath & "\"
		.CopyFile "C:\Project\Program\No00010\BookmarkMakeFile" & "\" & "bkmksopen4_04.vbs", folderPath & "\"
		.CopyFile "C:\Project\Program\No00010\BookmarkMakeFile" & "\" & "bkmksopen4_05.vbs", folderPath & "\"
		.CopyFile "C:\Project\Program\No00010\BookmarkMakeFile" & "\" & "bkmksopen4_06.vbs", folderPath & "\"
		.CopyFile "C:\Project\Program\No00010\BookmarkMakeFile" & "\" & "bkmksopen4_07.vbs", folderPath & "\"
	End With
	Set ObjFSO = Nothing
End Sub

	'FileSystemObject オブジェクト	: https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/filesystemobject-object
	'OpenTextFile 					: https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/opentextfile-method
	'CreateTextFile 				: https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/createtextfile-method
	'Write メソッド          		: https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/write-method
	'WriteLine メソッド      		: https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/writeline-method
	'Stream オブジェクト 			: https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/stream-object-properties-methods-and-events?view=sql-server-ver15
	'Stream オブジェクト (ADO) 		: https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/stream-object-ado?view=sql-server-ver15
	'Charset プロパティ (ADO) 		: https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/charset-property-ado?view=sql-server-ver15
	'Mode プロパティ (ADO) 			: https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/mode-property-ado?view=sql-server-ver15
	'Type プロパティ (ADO Stream) 	: https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/type-property-ado-stream?view=sql-server-ver15
	'Open メソッド (ADO Stream) 	: https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/open-method-ado-stream?view=sql-server-ver15

プログラムについて

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

雑記

コロナの影響で、夏の厳しい暑さの中でもマスク生活が余儀なくされています。もはや常日頃からマスクは欠かせない日常アイテムとなっていますが、そんな中、「マスク頭痛」に悩まされている人も多いということをご存知でしょうか。

私もつい最近知ったのですが、マスクをつけているとマスク内の温度や湿度が上がり、蒸し暑くなることなどが原因で起こる頭痛のことをマスク頭痛と呼ぶそうです。

マスク内は簡単に４０度を超え、私たちが思っている以上に蒸し暑くなっているだけでなく、二酸化炭素過多状態にも陥りやすいです。夏場は特に熱中症の恐れもあるので気をつけなければなりません。

まだまだコロナが収束しない以上、マスクをしないで出歩くことはできませんが、ソーシャルディスタンスを保つことができ、感染の心配のない場所へ移動したりして、１時間に数分でもマスクを外す時間を得ることを心掛け、安全なマスク生活を送りましょう。

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

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

スポンサーリンク

-その他