その他

VBScriptでファイル・フォルダ操作をしてエラーになってもエラー解決するまで繰り返すコード[No59]

スポンサーリンク

vbsプログラムでファイル操作・フォルダ操作をすると、エラーになることがあります。Windowsの場合、ファイル名・フォルダ名に「\ / : ? " < > |」を使うと『ファイル名には次の文字は使えません』というエラーが発生してしまいます。また、予約語を使うと『指定されたデバイス名は無効です。』、「.（ドット、ピリオド）」だけだと「パラメーターが間違っています。』というエラーが発生してしまいます。

この記事では、フォルダの作成時に「フォルダ名に使えない文字」でエラーが発生しても、エラーを解消することができるまで、新しいフォルダ名の入力画面を繰り返すような処理を紹介します。

その処理のために用意したプログラムは２種類あります。

プログラム１

準備

新しいフォルダに「createFolder01.vbs」（コードは下図参照）と「text.html」（必ずエラーが発生する文字をファイル内に記載）を作成します。

処理内容

フォルダ作成時、エラーが発生すると再処理をするように促されます。フォルダ作成時に同じフォルダが存在する場合は処理を終了します。

「createFolder01.vbs」の「'Dim folderName :folderName = curDir & "\" & record」のコメントアウトを外すなどすると、「text.html」の中の文字を読み込んで、その名前をフォルダ名に使えるようになります。


投稿 < ABC?


Option Explicit

'*********************************************************
'用途:カレントディレクトリのパスを取得する
'*********************************************************
Function GetCurDir()
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	GetCurDir               = ObjFSO.getParentFolderName(WScript.ScriptFullName)
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

'*********************************************************
'用途:フォルダを作成する（存在チェックでなければ）
'引数:folderPath(作成するフォルダの場所)
'*********************************************************
Sub CreateFolder(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
	Else
		ObjFSO.CreateFolder(folderPath)
		If Err.Number = 0 Then
		End If
	End If
	
	Set ObjFSO = Nothing
End Sub

'*********************************************************
'------------------------------------------------------------------------
'カレントディレクトリのパスを取得する
'------------------------------------------------------------------------
Dim CurDir : CurDir = GetCurDir()
'------------------------------------------------------------------------
'htmlファイルを読み込む
'------------------------------------------------------------------------
Dim inputFilePath : inputFilePath = curDir & "\" & "text.html"
Dim record : record = ReadFile_ADODBStream(inputFilePath)

Dim folderName :folderName = curDir & "\" & "投稿 > ABC?"
'Dim folderName :folderName = curDir & "\" & record
Dim cancelFlg

MsgBox "【" & folderName & "】"

On Error Resume Next
CreateFolder(curDir & "\" & folderName)
If Err.Number <> 0 Then
	Dim errFlg : errFlg = true
	cancelFlg = false
	Dim strText
	
	'Whileは条件が真の間だけループする
	Do While errFlg = true
		strText = ""
		strText = strText & "＜入力文字＞"						& Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10)
		strText = strText & "【" & folderName & "】"			& Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
		strText = strText & "＜案内＞"							& Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10)
		strText = strText & "エラーになりました。考えられる原因は「入力文字の文字コードに問題がある」か「予約語が入力されている」、「未入力」です。正しくなるよう入力してください。" & Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
		strText = strText & "＜Err詳細＞"						& Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10)
		strText = strText & "Number:" 		& Err.Number 		& Chr(13) & Chr(10)
		strText = strText & "Source:" 		& Err.Source 		& Chr(13) & Chr(10)
		strText = strText & "Description:" 	& Err.Description 	& Chr(13) & Chr(10)
		strText = strText & "Helpfile:" 	& Err.Helpfile 		& Chr(13) & Chr(10)
		strText = strText & "HelpContext:" 	& Err.HelpContext 	& Chr(13) & Chr(10)
		strText = strText & "LastDllError:" & Err.LastDllError	& Chr(13) & Chr(10)
		strText = strText & "---------------------------------"
		Err.Clear
		
		folderName = inputbox(strText)
		
		If IsEmpty(folderName) = true Then
			MsgBox "キャンセルが選択されました"
			cancelFlg = True
			errFlg = false
		ElseIF folderName = "" Then
			MsgBox "未入力です。"
		Else
   			CreateFolder(curDir & "\" & folderName)
   			errFlg = false
   			If Err.Number <> 0 Then
				errFlg = True
   			End If
		End If
   	Loop
End If
On Error Goto 0

If cancelFlg = True Then
	MsgBox "キャンセルを選択した場合の処理"
End If

スポンサーリンク

プログラム２

準備

新しいフォルダに「createFolder02.vbs」（コードは下図参照）と「text.html」（必ずエラーが発生する文字をファイル内に記載）を作成します。

処理内容

フォルダの存在チェックを行い、フォルダがないという結果になった場合はフォルダ作成を行います。存在チェックでフォルダがあるという結果になった場合は、再処理をするように促されます。

「createFolder02.vbs」の「'Dim folderName :folderName = curDir & "\" & record」のコメントアウトを外すなどすると、「text.html」の中の文字を読み込んで、その名前をフォルダ名に使えるようになります。


Option Explicit

'************************************************************************
'用途:カレントディレクトリのパスを取得する
'************************************************************************
Function GetCurDir()
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	GetCurDir               = ObjFSO.getParentFolderName(WScript.ScriptFullName)
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

'************************************************************************
'用途:フォルダを作成する（存在チェックでなければ）
'引数:folderPath(作成するフォルダの場所)
'************************************************************************
Sub CreateFolder(ByVal folderPath)
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	ObjFSO.CreateFolder(folderPath)	
	Set ObjFSO = Nothing
End Sub

'************************************************************************
'用途:フォルダの存在チェック
'引数:folderPath(作成するフォルダの場所)
'************************************************************************
Function CheckExistsFolder(ByVal folderPath)
	Dim ObjFSO : Set ObjFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If ObjFSO.FolderExists(folderPath) = True Then
		Set ObjFSO = Nothing
		CheckExistsFolder = True
	Else
		CheckExistsFolder = False
	End If
End Function

'************************************************************************
'------------------------------------------------------------------------
'カレントディレクトリのパスを取得する
'------------------------------------------------------------------------
Dim CurDir : CurDir = GetCurDir()
'------------------------------------------------------------------------
'htmlファイルを読み込む
'------------------------------------------------------------------------
Dim inputFilePath : inputFilePath = curDir & "\" & "text.html"
Dim record : record = ReadFile_ADODBStream(inputFilePath)

Dim folderName :folderName = curDir & "\" & "投稿 > ABC?"
'Dim folderName :folderName = curDir & "\" & record
Dim cancelFlg

MsgBox "【" & folderName & "】"

On Error Resume Next
Dim existsCheckFolderFlg
existsCheckFolderFlg = CheckExistsFolder(curDir & "\" & folderName)
IF existsCheckFolderFlg = False Then
	CreateFolder(folderName)
End If
If (Err.Number <> 0) OR (existsCheckFolderFlg = True) Then
	Dim errFlg : errFlg = true
	cancelFlg = false
	Dim strText
	
	'Whileは条件が真の間だけループする
	Do While errFlg = true
		strText = ""
		strText = strText & "＜入力文字＞"						& Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10)
		strText = strText & "【" & folderName & "】"			& Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
		strText = strText & "＜案内＞"							& Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10)
		strText = strText & "エラーになりました。考えられる原因は「入力文字の文字コードに問題がある」か「予約語が入力されている」、「未入力」、「既に同名のフォルダがある」です。正しくなるよう入力してください。" & Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
		strText = strText & "＜Err詳細＞"						& Chr(13) & Chr(10)
		strText = strText & "---------------------------------" & Chr(13) & Chr(10)
		strText = strText & "Number:" 		& Err.Number 		& Chr(13) & Chr(10)
		strText = strText & "Source:" 		& Err.Source 		& Chr(13) & Chr(10)
		strText = strText & "Description:" 	& Err.Description 	& Chr(13) & Chr(10)
		strText = strText & "Helpfile:" 	& Err.Helpfile 		& Chr(13) & Chr(10)
		strText = strText & "HelpContext:" 	& Err.HelpContext 	& Chr(13) & Chr(10)
		strText = strText & "LastDllError:" & Err.LastDllError	& Chr(13) & Chr(10)
		strText = strText & "---------------------------------"
		Err.Clear
		
		folderName = inputbox(strText)
		
		If IsEmpty(folderName) = true Then '「folderName = ""」は未入力。
			MsgBox "キャンセルが選択されました"
			cancelFlg = True
			errFlg = false
		ElseIf folderName = "" Then
			MsgBox "未入力です。"
		Else
			existsCheckFolderFlg = CheckExistsFolder(curDir & "\" & folderName)
			IF existsCheckFolderFlg = True Then
				MsgBox "既にフォルダが存在しています。"
			ElseIf existsCheckFolderFlg = False Then
   				CreateFolder(curDir & "\" & folderName)
   			End If
   			errFlg = false
   			If (Err.Number <> 0) OR (existsCheckFolderFlg = True) Then
				errFlg = True
   			End If
		End If
   	Loop
End If
On Error Goto 0

If cancelFlg = True Then
	MsgBox "キャンセルを選択した場合の処理"
End If

雑記

先日、私の応援している芸能人の方が誕生日を迎えられました。ケーキやプレゼントを用意したりはしていませんが、自宅で生誕祭の配信を見ながら心の中でお祝いさせて頂きました。

現在では、個人の誕生日をお祝いすることは一般的なことですが、昔は「数え年」で年齢を数えることが普通で、正月と共に一斉に年をとっていたため、日本には誕生日をお祝いする習慣がなかったそうです。日本で個人の誕生日が祝われるようになったのは、昭和24年に「年齢のとなえ方に関する法律」が制定され、満年齢での数え方が普及してだと言われています。今では定番となっている誕生日にバースデーケーキを食べる習慣も、戦後に日本に伝わったものと言われています。

自分が誕生日を祝われるのはもちろんですが、家族や友人、恋人、好きな芸能人や漫画のキャラクターなど、自分の大切な人の誕生日を祝うことができるのも嬉しいことですよね。大切な人には幸福で満ち溢れた誕生日を過ごしてほしいものです。

誕生日は１年に１度しか訪れないので、いくつになってもワクワクするし、特別な日としてとらえている人が多いと思います。そんな一人一人の誕生日を祝うことができる、素敵な風習を生み出してくれた昔の日本人の方々には感謝したいところです。特に何をするでもなく、ただ一言「誕生日おめでとう」と誰かに言ってもらえる喜び、大切な人に「生まれてきてくれてありがとう」と伝えることができる喜びを、これからも大切にしていきたいと思います。

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

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

スポンサーリンク

-その他