ファイル名を判断し、該当フォルダに移動 (バッチ?)

質問

以下のようなファイル名のファイルが C:\txtにあります。 (便宜上で、実際は、社内の共有サーバーにあります。)

AB010900953(02月27日).txt

コードの意味は、
AB - 固定のアルファベット
01 - 地域コード (01 本社、02 西日本、03 中部、04 九州、05 東北、06 中四国、07 神奈川)
09 - 2009年
00953 - 連番

フォルダ構成は、
C:\2009年、C:\2010年・・・

C:\2009年\本社、C:\2009年\西日本、C:\2009年\中部、C:\2009年\九州、C:\2009年\東北、C:\2009年\中四国、C:\2009年\神奈川

C:\2009年\本社\～AB010900200
　[このフォルダにAB010900001(xx月xx日).txt～AB010900200(xx月xx日).txtが入る]
C:\2009年\本社\～AB010900400
　[このフォルダにAB010900201(xx月xx日).txt～AB010900400(xx月xx日).txtが入る]

C:\2009年\西日本\～AB020900100
　[このフォルダにAB020900001(xx月xx日).txt～AB020900100(xx月xx日).txtが入る]
C:\2009年\西日本\～AB020900200
　[このフォルダにAB020900101(xx月xx日).txt～AB020900200(xx月xx日).txtが入る]

これをいちいち手動で振り分けるのが面倒なので、C:\txtに入れて、何かを実行したら、或いは1時間に1回自動的に、振り分けられるようにしたいです。また、ファイル名が間違っていたら、移動しないようにしたいです。宜しくお願い致します。

回答No.6

junkUser · ベストアンサー

重要フォルダに対応したものを作りました。
お試しください。
重要用と普通のファイル用とファイル名をチェックする関数が別にあるのでそれぞれ修正してください。
---------ここから-------
Option Explicit
' 検索対象のフォルダ
Const CFromFolder = "C:\txt"
' 保存先のフォルダ
Const CToFolder = "C:\fld"
' テストモード: これを True にする場合は CScript で起動してください。
Const TestMode = False

Dim FSO, Fld, FC, Entry, Fld2, FC2
Dim nameFailed
Dim chiikiFailed
Dim folderNotFound
Dim subfolderNotMatch
Dim movedFile
Dim ChiikiCode
Dim code, year, fileNumber
Dim moveToFolder
Set ChiikiCode = CreateObject("Scripting.Dictionary")
ChiikiCode.Add "01", "本社"
ChiikiCode.Add "02", "西日本"
ChiikiCode.Add "03", "中部"
ChiikiCode.Add "04", "九州"
ChiikiCode.Add "05", "東北"
ChiikiCode.Add "06", "中四国"
ChiikiCode.Add "07", "神奈川"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fld = FSO.GetFolder(CFromFolder)
Set FC = Fld.Files
nameFailed = 0
chiikiFailed = 0
folderNotFound = 0
movedFile = 0
If TestMode Then WScript.Echo "### Test Mode ###"
For Each Entry In FC
If checkName(Entry.Name) Then
code = CStr(Mid(Entry.Name, 3, 2))
year = CStr(Mid(Entry.Name, 5, 2))
fileNumber = CLng(Mid(Entry.Name, 3, 9))
' 地域コードのチェック
If ChiikiCode.Exists(code) Then
' 上位フォルダ (CToFolder\20xx年\地域名) の存在確認
moveToFolder = CToFolder & "\20" & year & "年\" & ChiikiCode(code)
If FSO.FolderExists(moveToFolder) Then
' 下位フォルダ (～AB[0-9]{9}) の保存先特定
Set Fld2 = FSO.GetFolder(moveToFolder)
subfolderNotMatch = True
For Each FC2 In Fld2.SubFolders
If Not FC2.Name = "重要" Then
If CLng(Mid(FC2.Name, 4, 9)) >= fileNumber Then
If TestMode Then
WScript.Echo Entry.Path & " -> " & vbNewLine & vbTab & FC2.Path & "\" & Entry.Name
movedFile = movedFile + 1
Else
Call FSO.MoveFile (Entry.Path, FC2.Path & "\" & Entry.Name)
movedFile = movedFile + 1
End If
subfolderNotMatch = False
Exit For
End If
End If
Next
If subfolderNotMatch Then
If TestMode Then
WScript.Echo "該当するフォルダが見つかりません: " & Entry.Name
End If
folderNotFound = folderNotFound + 1
End If
Else
If TestMode Then
WScript.Echo "フォルダが見つかりません: " & moveToFolder
End If
folderNotFound = folderNotFound + 1
End If
Else
If TestMode Then
WScript.Echo "地域コードが該当しません: " & Entry.Name
End If
chiikiFailed = chiikiFailed + 1
End If
Else
' 重要ファイル
If checkJuyo(Entry.Name) Then
code = CStr(Mid(Entry.Name, 7, 2))
year = CStr(Mid(Entry.Name, 9, 2))
fileNumber = CLng(Mid(Entry.Name, 7, 9))
' 地域コードのチェック
If ChiikiCode.Exists(code) Then
' フォルダ (CToFolder\20xx年\地域名\重要) の存在確認
moveToFolder = CToFolder & "\20" & year & "年\" & ChiikiCode(code) & "\重要"
If FSO.FolderExists(moveToFolder) Then
If TestMode Then
WScript.Echo Entry.Path & " -> " & vbNewLine & vbTab & moveToFolder & "\" & Entry.Name
movedFile = movedFile + 1
Else
Call FSO.MoveFile (Entry.Path, moveToFolder & "\" & Entry.Name)
movedFile = movedFile + 1
End If
Else
If TestMode Then
WScript.Echo "フォルダが見つかりません: " & moveToFolder
End If
folderNotFound = folderNotFound + 1
End If
Else
If TestMode Then
WScript.Echo "地域コードが該当しません: " & Entry.Name
End If
chiikiFailed = chiikiFailed + 1
End If
Else
If TestMode Then
WScript.Echo "書式エラー: " & Entry.Name
End If
nameFailed = nameFailed + 1
End If
End If
Next
WScript.Echo movedFile & " 個のファイルを移動しま(す or した)。" & _
vbNewLine & nameFailed & " 個のファイル名に書式エラーがあります。" & _
vbNewLine & chiikiFailed & " 個のファイル名の地域コードがありません。" & _
vbNewLine & folderNotFound & " 個のファイルに該当するフォルダが見つかりません。"

' ファイル名のチェック
Function checkName(ByVal name) ' As Boolean
Dim returnValue
Dim regEx
returnValue = False
Set regEx = New RegExp
' AB数字9ケタ(???).txt にマッチ
regEx.Pattern = "^AB[0-9]{9}\(.+\)\.txt$"
regEx.Global = False
regEx.IgnoreCase = False
If regEx.Test(name) Then returnValue = True
checkName = returnValue
End Function
Function checkJuyo(ByVal name) ' As Boolean
Dim returnValue
Dim regEx
returnValue = False
Set regEx = New RegExp
' 【重要】AB数字9ケタ(???).txt にマッチ
regEx.Pattern = "^【重要】AB[0-9]{9}\(.+\)\.txt$"
regEx.Global = False
regEx.IgnoreCase = False
If regEx.Test(name) Then returnValue = True
checkJuyo = returnValue
End Function

お礼

ありがとうございます。

遅くなりました。
今日になってやっと試す時間ができました。
残念ながら、エラーが出ました。

C:\>cscript quotation.vbs
Microsoft (R) Windows Script Host Version 5.7
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

0 個のファイルを移動しま(す or した)。
1 個のファイル名に書式エラーがあります。
0 個のファイル名の地域コードがありません。
0 個のファイルに該当するフォルダが見つかりません。

補足

すみません。
家に帰ってきて思ったのですが、私のミスだと思います。
一部書き換えて、改めて実行してみます。

回答No.7

junkUser

＞残念ながら、エラーが出ました。
＞1 個のファイル名に書式エラーがあります。

これはスクリプトのエラーではなく、ファイル名が間違っていると言っています。
regEx.Pattern = "^AB[0-9]{9}\(.+\)\.txt$"
の行と
regEx.Pattern = "^【重要】AB[0-9]{9}\(.+\)\.txt$"
の行が別々に存在するのでそれぞれ修正してください。

お礼

お返事遅くなりまして申し訳ございません。

助かりました。
ありがとうございました。(^^)

回答No.5

junkUser

C:\quotation.vbs(49, 1) Microsoft VBScript 実行時エラー: 型が一致しません。: 'CLng'

49行目の
Mid(FC2.Name, 4, 9)
が数字になっていないようですね。
FC2.Name は "～AB123456789" のようなフォルダ名しか存在しないと想定しています。
おそらく「重要」フォルダを見つけてこれが数字にならないためエラーになるのでしょう。
ちょっと修正してみます。

回答No.4

junkUser

【重要】フォルダの件はすぐに改良できると思いますが、とりあえず現状のスクリプトがご期待通り動作するか確認してみてください。

スクリプトの内容を見ればすぐにわかると思いますが、TestMode = True に変更することで、どのファイルがどこのフォルダに保存されるか確認できるようになっています。

実行方法はコマンドプロンプトから
> cscript スクリプトを保存したファイル.vbs
です。
もしダブルクリックで実行すると大量にOKを押す羽目になります。

お礼

ありがとうございます。
でも、なぜかうまくいきませんでした。

C:\>cscript quotation.vbs
Microsoft (R) Windows Script Host Version 5.7
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

C:\quotation.vbs(49, 1) Microsoft VBScript 実行時エラー: 型が一致しません。: 'CL
ng'

回答No.3

junkUser

回答番号：No.2 は VBScript です。
ファイル名.vbs で保存して実行してみてください。

回答No.2

junkUser

書いてみました。
CFromFolder,CToFolder, あと、下の regEx.Pattern の正規表現を適宜読み替えてください。
AB数字9ケタ(???).txt で適合するようになっています。

Option Explicit
' 検索対象のフォルダ
Const CFromFolder = "C:\txt"
' 保存先のフォルダ
Const CToFolder = "C:\fld"
' テストモード: これを True にする場合は CScript で起動してください。
Const TestMode = False

Dim FSO, Fld, FC, Entry, Fld2, FC2
Dim nameFailed
Dim chiikiFailed
Dim folderNotFound
Dim subfolderNotMatch
Dim movedFile
Dim ChiikiCode
Dim code, year, fileNumber
Dim moveToFolder
Set ChiikiCode = CreateObject("Scripting.Dictionary")
ChiikiCode.Add "01", "本社"
ChiikiCode.Add "02", "西日本"
ChiikiCode.Add "03", "中部"
ChiikiCode.Add "04", "九州"
ChiikiCode.Add "05", "東北"
ChiikiCode.Add "06", "中四国"
ChiikiCode.Add "07", "神奈川"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fld = FSO.GetFolder(CFromFolder)
Set FC = Fld.Files
nameFailed = 0
chiikiFailed = 0
folderNotFound = 0
movedFile = 0
If TestMode Then WScript.Echo "### Test Mode ###"
For Each Entry In FC
If checkName(Entry.Name) Then
code = CStr(Mid(Entry.Name, 3, 2))
year = CStr(Mid(Entry.Name, 5, 2))
fileNumber = CLng(Mid(Entry.Name, 3, 9))
' 地域コードのチェック
If ChiikiCode.Exists(code) Then
' 上位フォルダ (CToFolder\20xx年\地域名) の存在確認
moveToFolder = CToFolder & "\20" & year & "年\" & ChiikiCode(code)
If FSO.FolderExists(moveToFolder) Then
' 下位フォルダ (～AB[0-9]{9}) の保存先特定
Set Fld2 = FSO.GetFolder(moveToFolder)
subfolderNotMatch = True
For Each FC2 In Fld2.SubFolders
If CLng(Mid(FC2.Name, 4, 9)) >= fileNumber Then
If TestMode Then
WScript.Echo Entry.Path & " -> " & vbNewLine & vbTab & FC2.Path & "\" & Entry.Name
movedFile = movedFile + 1
Else
Call FSO.MoveFile (Entry.Path, FC2.Path & "\" & Entry.Name)
movedFile = movedFile + 1
End If
subfolderNotMatch = False
Exit For
End If
Next
If subfolderNotMatch Then
If TestMode Then
WScript.Echo "該当するフォルダが見つかりません: " & Entry.Name
End If
folderNotFound = folderNotFound + 1
End If
Else
If TestMode Then
WScript.Echo "フォルダが見つかりません: " & moveToFolder
End If
folderNotFound = folderNotFound + 1
End If
Else
If TestMode Then
WScript.Echo "地域コードが該当しません: " & Entry.Name
End If
chiikiFailed = chiikiFailed + 1
End If
Else
If TestMode Then
WScript.Echo "書式エラー: " & Entry.Name
End If
nameFailed = nameFailed + 1
End If
Next
WScript.Echo movedFile & " 個のファイルを移動しま(す or した)。" & _
vbNewLine & nameFailed & " 個のファイルに書式エラーがあります。" & _
vbNewLine & chiikiFailed & " 個のファイル名の地域コードがありません。" & _
vbNewLine & folderNotFound & " 個のファイルに該当するフォルダが見つかりません。"

' ファイル名のチェック
Function checkName(ByVal name) ' As Boolean
Dim returnValue
Dim regEx
returnValue = False
Set regEx = New RegExp
' AB数字9ケタ(???).txt にマッチ
regEx.Pattern = "^AB[0-9]{9}\(.+\)\.txt$"
regEx.Global = False
regEx.IgnoreCase = False
If regEx.Test(name) Then returnValue = True
checkName = returnValue
End Function

お礼

まだ試していませんが、すごい!!
すごすぎます!!
これでできるんですね。

会社で試してみます!!
ありがとうございました。(^-^)

補足

これだけでも十分なのですが、本当はもう一つあって、ややこしくなりそうなので書きませんでしたが、もし可能ならばやりたいという感じです。

ほんのたまにですが、以下のようなファイル名のファイルがあります。

【重要】AB010900953(02月27日).txt

頭に【重要】がつくだけです。
これは、移動先が少し違うのです。

C:\2009年\本社\～AB010900200
　と同じディレクトリに
C:\2009年\本社\重要
　という「重要」ディレクトリがあります。

C:\2009年\本社\重要
C:\2009年\西日本\重要
　と全ての地域に「重要」ディレクトリがあります。

【重要】ファイルは、その地域の【重要】フォルダに入れるのです。
今のままでも十分実用的ですので、もし可能ならばで構いません。

回答No.1

n-jun

直接の回答ではないですが、

＞また、ファイル名が間違っていたら、移動しないようにしたいです。
間違っていたらとは、
・あり得ないファイル名をつけた
・地域コードや連番等をつけ間違えた
等々想定される内容を提示された方がいいかもしれません。

お礼

そうですね。
ありがとうございます。
間違っているとは、移動先フォルダが無いがないということです。

- AB01～AB07以外で始まっている
- AB01～AB07の後が10 (2010年) である (将来、フォルダができたら移動可です。)
- AB010900401で始まっている (連番は、フォルダの名前から移動先を判断します。フォルダが無かったら移動せず、できたら移動可です。)
- AB0109001000 (桁数が違うので、移動しない)

宜しくお願いします。