''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'エビデンスフォルダ作成用スクリプト
'
'要適宜変更箇所:strDefFilePath(エビデンスフォルダを作成するためのトップディレクトリ)
' strCreateFolderPath(作成したいフォルダを記載したファイルのパス)
'
'仕様:strCreateFolderPathのパスで指定したファイル中に、作成したいフォルダ名を記載します。
' フォルダの中に更にフォルダを作成したい場合は、タブ区切りで記載してください。
' 例)
' 1
' 1-1
' 1-2
' 1-2-1
' 1-3
' 2
' 2-1
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Dim objFileSys
Dim objTextStream
'デフォルトファイルパス
Dim strDefFilePath
strDefFilePath = "C:\test"
'フォルダ作成用ファイルパス
Dim strCreateFolderPath
strCreateFolderPath = "c:\test\test.txt"
Set objFileSys = CreateObject("Scripting.FileSystemObject")
Call Main()
Sub Main()
Dim strText
Dim iBefTabCount
Dim strFilePath
Dim strBefData(100)
Dim iTab
Dim i
strFilePath = strDefFilePath
iBefTabCount = 0
Set objTextStream = objFileSys.OpenTextFile(strCreateFolderPath, 1)
'EOLになるまでループ
Do Until objTextStream.AtEndOfLine = True
'1行読み込み
strText = objTextStream.ReadLine
'読み込んだ文字列内のタブの数をカウント
i = 1
iTab = 0
Do
If InStr(i, strText, vbTab, 0) <> 0 Then
'タブが見つかった次の文字列から再度検索
iTab = iTab + 1
i = i + 1
Else
Exit Do
End If
Loop
'今回のタブの数が前回のタブ数より大きいか判定
If iTab > iBefTabCount Then
'前回の文字列をファイルパスに追加
strFilePath = objFileSys.BuildPath(strFilePath, strBefData(iBefTabCount))
'前回のタブ数として保持していた値をカウントアップ
iBefTabCount = iBefTabCount + 1
'今回のタブの数が前回のタブ数より小さいか判定
ElseIf iTab < iBefTabCount Then
'今回のタブ数を前回のタブ数として保持
iBefTabCount = iTab
'今回のタブ数分ディレクトリを元に戻す
'デフォルトディレクトリ+今回のタブ数までの値をフォルダパスとする
strFilePath = strDefFilePath
i = 0
Do Until i = iTab
strFilePath = objFileSys.BuildPath(strFilePath, strBefData(i))
i = i + 1
Loop
End If
'フォルダ作成処理
Call MakeFolder(0, strFilePath, strText)
'今回のフォルダ名称を取得
strBefData(iTab) = Replace(strText, vbTab, "")
Loop
'クローズ処理
objTextStream.Close
Set objTextStream = Nothing
Set objFileSys = Nothing
End Sub
Private Sub MakeFolder(ByVal iTabCount, ByVal strFP, ByVal strText)
strText = Replace(strText, vbTab, "")
'フォルダ存在確認してからフォルダ作成
If objFileSys.FolderExists( objFileSys.BuildPath(strFP, strText) ) = False Then
objFileSys.CreateFolder(objFileSys.BuildPath(strFP, strText))
End If
End Sub