フォルダー名の複雑な変更 (2)

質問

以下で質問をしました。
https://okwave.jp/qa/q9521359.html

watabe007さんから頂いたスクリプトを有効に利用させて頂いています。

色々試してみると処理できる場合もありますが、
　　フォルダー処理でエラーが出る場合があるのですが、コードを修正できますか？

以下のフォルダーでエラー表示（添付）がでます。

The Blues Band – The Rooster Crowed(2018)
Sisare – Leaving The Land (2018)

-------------------------------------------------
VBScript

Option Explicit
Dim objFSO
Dim args
Dim newName
Dim f1, fol

Set args = WScript.Arguments
If args.Count < 1 Then WScript.Quit
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each f1 in args
set fol = objFSO.GetFolder(f1)
newName = GetnewFName(fol.Name)
If newName <> "" Then
fol.Name = newName
End If
Next
Set objFSO = Nothing

Function GetnewFName(strName)
Dim objRE
Dim myMatches
Dim strYear
Set objRE = CreateObject("VBScript.RegExp")
objRE.Pattern = "\(\d{4}\)"
Set myMatches = objRE.Execute(strName)
If myMatches.Count > 0 Then
strYear = Mid(myMatches(0).Value, 2, 4)
GetnewFName = strYear & " " & strName
End If
Set objRE = Nothing
End Function

回答No.9

Prome_Lin · ベストアンサー

Option Explicit
Dim f, i, so, wa, x
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
f = ""
For i = 0 to wa.Count - 1
x = wa(i)
If InStr(x, "?") > 0 Then
f = f & x & vbCrLf
End If
Next
Set wa = Nothing
Set so = Nothing
If f <> "" Then
MsgBox(f)
Else
MsgBox("Nothing!")
End If

ドラッグ＆ドロップしたフォルダ内に「Unicode文字」が存在すると、まとめて、最後に表示します。

以下は、読んでいただかなくても結構です。

今朝、念のため、他のパソコンでも、私の作ったプログラムを実行してみたのですが、やはり問題なく、Unicode文字の「–」が、半角の「-」に置換された上で、フォルダ名もすべて、問題なく変更できました。

ただ、私はパソコンを３台持っているのですが、すべて「Windows10 Pro 64bit」の環境なので、結果が同じなのは、当然なのですが・・・

何か、質問者と環境が大きく違うのでしょうか？

お礼

レス感謝します。

海外ローダーに問題のフォルダー（ファイル）をUPして
ダウンロードしていただき
Prome_Linさんにどこが問題なのかチェックをお願いする文章を
書き込みましたが、okwaveの方で一部を残して削除されたようです。

（文章で残ったのは、後半の部分のみです。）

頂いた「Unicode文字」が存在をチェックするスクリプトでチェックすると
エラーが出る下記がやはりだめだと判定されました。
　　Drowning Steps – The Comfort Of An Endless Pain(2017)Progressive Rock

やはり、Unicode文字の「–」が原因のようです。

下記参照下さい。
https://imgur.com/a/6wNmeNm

私のPCの環境は、
　　windows_10 Pro X64（1803　ver 17134.167)
で同じですね。

環境の違いは、明確にできないので再現性が無く残念です。

補足

私の環境では、Unicode文字の処理がvbsで上手く処理できないようなので
マクロが利用できる『お～瑠璃ね～』でUnicode文字の「–」を、半角の「-」に置換後に
Prome_Linさんのスクリプトを利用させていただくようにしました。

数日に渡り貴重なアドバイスをいただき改めて感謝いたします。

回答No.8

Prome_Lin

そうなんですか！？

こちらで、

The Blues Band – The Rooster Crowed(2018)
Sisare – Leaving The Land (2018)
Songbirds - 機関車 (1995) jpPop
Nodubut - Ten Day(2003)
A – Z

という５つのフォルダを同じフォルダ内に作成し、上の４つだけをドラッグ＆ドロップして、問題なく、４フォルダとも、こちらでは処理できたのですが・・・

また、前回の回答でも、言いましたように、ドラッグ＆ドロップしていない「A – Z」も「A - Z」になってしまいました。

私としては、Unicode「–」が、質問者の実際のフォルダでは、違うUnicode文字が使われているとしか、思えないのですが・・・

ん～ん、困りました。

お礼

何度もすいません。

出来れば、
　VBSで上手く処理できないUnicode文字をチェックできる方法があれば教えて下さい。
（Unicode文字を含んでいるフォルダーが特定できるように事前チェックすると
　　　事前に手動で書き換えるとの選択肢も考えられるので）

回答No.7

Prome_Lin

私の力不足で申し訳ないのですが、一応の結果は出ました。

最大の問題は、親フォルダをドラッグ＆ドロップしたときのプログラムは、

For Each f In gf.SubFolders

というように、ドラッグ＆ドロップしたフォルダ直下のサブフォルダを調べます。

このやり方でしたら、Unicode文字に対処できたのですが、直接、名前を変更したいフォルダをドラッグ＆ドロップするプログラムでは、どうしても、「so.GetFolder()」で、フォルダの取得が出来ないのです。

「For Each f ～」の「f」も「Set f = so.GetFolder()」の「f」も同じ「オブジェクト」なのに・・・

そこでやむを得ず、以下のようにしました。

ドラッグ＆ドロップされたすべてのフォルダの親フォルダから、その親フォルダ直下のすべてのサブフォルダの「–」を、半角の「-」に置換してしまってから、もう一度、ドラッグ＆ドロップされたフォルダのフォルダ名の変更処理を行っています。

★★★
このプログラムの最大の問題は、ドラッグ＆ドロップしていないフォルダの「–」まで「-」に置換してしまうことです。

しかし、上述のとおり「so.GetFolder()」が使えないため、ドラッグ＆ドロップされたフォルダかどうか、特定できないのです。

もし、それでも問題がなければ、お使いください。

Option Explicit
Dim c, f, gf, i, n(), p, p1, p2, so, wa, x
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
c = wa.Count - 1
ReDim n(c)
For i = 0 to c
n(i) = wa(i)
n(i) = Replace(n(i), "?", "-")
Set gf = so.GetFolder(so.GetParentFolderName(wa(i)))
For Each f In gf.SubFolders
If InStr(f.Name, "–") > 0 Then
f.Name = Replace(f.Name, "–", "-")
End If
Next
Next
For i = 0 to c
Set f = so.GetFolder(n(i))
p1 = InStr(f.Name, "(")
p2 = InStr(f.Name, ")")
If p1 > 0 and p2 > 0 and p1 < p2 Then
p = Mid(f.Name, p1 + 1, p2 - p1 - 1) & " " & f.Name
f.Name = p
Set f = Nothing
End If
Next
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

最初に、

For i = 0 to c
n(i) = wa(i)
n(i) = Replace(n(i), "?", "-")
Set gf = so.GetFolder(so.GetParentFolderName(wa(i)))
For Each f In gf.SubFolders
If InStr(f.Name, "–") > 0 Then
f.Name = Replace(f.Name, "–", "-")
End If
Next
Next

ドラッグ＆ドロップされたフォルダの親フォルダの中のサブフォルダのフォルダ名に含まれる「–」を「-」に置換して、フォルダ名を変更しています。

ここで分かるように、本来は「n(i) = Replace(n(i), "–", "-")」のはずなのに「–」が、「?」となっています。

これが、すべての原因なのですが、私では、どうすることも出来ませんでした。

For i = 0 to c
Set f = so.GetFolder(n(i))
p1 = InStr(f.Name, "(")
p2 = InStr(f.Name, ")")
If p1 > 0 and p2 > 0 and p1 < p2 Then
p = Mid(f.Name, p1 + 1, p2 - p1 - 1) & " " & f.Name
f.Name = p
Set f = Nothing
End If
Next

もう一度、最初から、フォルダ名の変更を行っています。

お礼

Prome_Linさん、何度も修正のスクリプトありがとうございます。

Unicode文字に対処するには、VBSの仕様で親フォルダーから参照するのが解決の早道なのを理解しました。

今回提供されたコードでサンプルフォルダーでテストしてみました。

　　Unicode文字が含まれないフォルダーはうまく処理できましたが
　　Unicode文字を含んだフォルダーは、エラーがでます。
　　　　　コードが見やすいようにコメントアウトした行を挿入したため、
　　　　　　エラー行24は,問題に挙げられていた
　　　　　　 　Set f = so.GetFolder(n(i))
　　　　　　になります。
　　又、
　　Unicode文字の「–」を半角に変更されるはずなのに変更されていません。

　　エラーがでるため、それ以降にフォルダーがあっても処理自体がSTOPしてしまいます。
　　　　（この結果は、当然なのは十分理解しています。）

心苦しいのですが、どうも意図した処理が上手く行っていないように感じます。

回答No.6

Prome_Lin

失礼しました。

「Sisare – Leaving The Land (2018)」などのフォルダ群が存在する直上のフォルダをドラッグ＆ドロップする形式に変更しました。

また、「Sisare – Leaving The Land (2018)」の「–」についてだけですが、「-」に置換してからファイル名を変更していますので、Unicode文字「–」だけには対応しました。

Option Explicit
Dim f, gf, m, n, p, p1, p2, so, wa
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
If wa.Count <> 1 or so.FolderExists(wa(0)) = False Then
MsgBox("ドラッグ＆ドロップできるのは、フォルダ１つだけです")
WScript.Quit
End If
Set gf = so.GetFolder(wa(0))
For Each f In gf.SubFolders
If InStr(f.Name, "–") > 0 Then
Set m = so.GetFolder(gf & "\" & f.Name)
m.Name = Replace(f.Name, "–", "-")
n = m.Name
Set m = Nothing
Else
n = f.Name
End If
p1 = InStr(n, "(")
p2 = InStr(n, ")")
If p1 > 0 and p2 > 0 and p1 < p2 Then
p = Mid(n, p1 + 1, p2 - p1 - 1) & " " & n
Set m = so.GetFolder(gf & "\" & n)
m.Name = p
Set m = Nothing
End If
Next
Set gf = Nothing
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

簡単な説明です。

If wa.Count <> 1 or so.FolderExists(wa(0)) = False Then

ドラッグ＆ドロップした「もの」が１つだけか、また、それが「フォルダ」か判定しています。

したがって、ファイルをドラッグ＆ドロップした場合には、プログラムは、メッセージを表示して、プログラムそのものを終了してしまいます。

Set gf = so.GetFolder(wa(0))

ドラッグ＆ドロップしたフォルダを取得しています。

For Each f In gf.SubFolders

ドラッグ＆ドロップされたフォルダ直下のサブフォルダをすべて調べます。

If InStr(f.Name, "–") > 0 Then

問題の「–」が含まれていた場合、

Set m = so.GetFolder(gf & "\" & f.Name)
m.Name = Replace(f.Name, "–", "-")
n = m.Name
Set m = Nothing

半角の「-」に置換して、フォルダ名を変更しています。

p1 = InStr(n, "(")
p2 = InStr(n, ")")
If p1 > 0 and p2 > 0 and p1 < p2 Then
p = Mid(n, p1 + 1, p2 - p1 - 1) & " " & n
Set m = so.GetFolder(gf & "\" & n)
m.Name = p
Set m = Nothing

ここは、前回と同じですので、説明を省略します。

End If
Next

を、すべてのサブフォルダで繰り返しています。

Set gf = Nothing
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

あとは、終了処理で、最後に「Finished!」と表示しています。

お礼

Prome_Linさん、
　　こちらこそ早合点で見当外れなクレームを付ける事になり申し訳ありません。

改編いただいたスクリプトをテストすると
　　フォルダーの先頭に西暦が付加される形式で処理されました。

この時点で「–」が「Unicode文字」のフォルダーをテストの為サンプルに加えていたのですが
「–」（Unicode文字）は、半角の「-」に変換されるはずなのに変換されず元のUnicode文字ままで
処理されています。
（つまり、オリジナルフォルダーの先頭に西暦が付加された形式で変名されました。）

------------------------------
スレッドの流れとしては、
　　Unicode文字を処理する場合、親フォルダーを利用する処理方法が出まして
　　そちらの方向で話が進んでいましたが、

私としては、出来れば
　　変名すべきフォルダーを処理用の親フォルダーに集めずに
　　改名すべきフォルダーそれぞれをファイラ（ファイルマネージャー）から選択して
　　デスクトップにある処理用のVBSスクリプト等にドラッグ＆ドロップして処理したいのです。

　　処理時に問題の「–」（Unicode文字）は、半角の「-」に変換されて処理後のフォルダー名にも
　　反映されれば嬉しいのですが？

　　これは、VBScriptの仕様のため、無理な相談なのでしょうか？

　　VBScriptには、こだわらないので他の言語？で処理できれば問題はありません。

---------------------------------

回答No.5

Prome_Lin

？？？

私、実際に、

Songbirds - 機関車 (1995) jpPop
Nodubut - Ten Day(2003)
Sisare - Leaving The Land (2018)
The Blues Band - The Rooster Crowed(2018)

フォルダを、作成し、この４つのフォルダをプログラムファイルにドラッグ＆ドロップした結果、

1995 Songbirds - 機関車 (1995) jpPop
2003 Nodubut - Ten Day(2003)
2018 Sisare - Leaving The Land (2018)
2018 The Blues Band - The Rooster Crowed(2018)

になるのを確認してから、回答したのですが？

お礼

大変失礼しました。

解説文がありながら
スレッドの流れで親フォルダー内に全ての処理すべきフォルダーを集めて
親フォルダーをドラッグ＆ドロップするものと決めつけてテストしていました。

親フォルダーではなく処理すべきフォルダーからドラッグ＆ドロップすると
問題なく処理できました。

「–」が「Unicode文字」の場合は、同じくエラーが出てしまいます。

事前（前処理として）に「–」が「Unicode文字」であれば、通常の半角の「-」に変換してやれば
　　上手く処理できるなら事前にそのための処理を追加できませんか？

前処理がVBScriptの仕様で処理できないのであれば
　　親フォルダーに集めて親フォルダーをドラッグ＆ドロップする形式を利用する事になりそうです。

回答No.4

Prome_Lin

The Blues Band – The Rooster Crowed(2018)
Sisare – Leaving The Land (2018)

の「–」が「Unicode文字」のため、エラーが出ます。

もし、「–」が通常の半角の「-」であれば、以下の「VBScript」で動きました。

Option Explicit
Dim f, i, p, p1, p2, so, wa, x, y
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
For i = 0 to wa.Count - 1
x = so.GetParentFolderName(wa(i))
y = Mid(wa(i), Len(x) + 2)
p1 = InStr(y, "(")
p2 = InStr(y, ")")
If p1 > 0 and p2 > 0 and p1 < p2 Then
p = Mid(y, p1 + 1, p2 - p1 - 1) & " " & y
Set f = so.GetFolder(wa(i))
f.Name = p
Set f = Nothing
End If
Next
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

簡単な説明です。

Option Explicit

「厳密に」とか「明確に」というような意味で、このオプションを設定すると、変数は、その使用の前に、「Dim」等によって宣言しておかなければなりません。

Set so = CreateObject("Scripting.FileSystemObject")

ファイルやフォルダを扱えるようにしています。

Set wa = WScript.Arguments

ドラッグ＆ドロップされるのを待っています。

For i = 0 to wa.Count - 1

ドラッグ＆ドロップされたフォルダを１つずつ処理。

x = so.GetParentFolderName(wa(i))

ドラッグ＆ドロップされたフォルダが、たとえば「D:\Programming\Songbirds - 機関車 (1995) jpPop」の場合、「D:\Programming」の部分を「x」に入れています。

y = Mid(wa(i), Len(x) + 2)

ドラッグ＆ドロップされた「Songbirds - 機関車 (1995) jpPop」の部分を「y」に入れています。

すなわち、どのフォルダに存在するか、という部分と、ドラッグ＆ドロップされたフォルダ自身の名前を分割しているわけです。

p1 = InStr(y, "(")
p2 = InStr(y, ")")

「(」と「)」の位置を調べています。

If p1 > 0 and p2 > 0 and p1 < p2 Then

「(」も「)」も存在して、なおかつ「(」の方が「)」より前に存在すれば、

p = Mid(y, p1 + 1, p2 - p1 - 1) & " " & y

「Mid(y, p1 + 1, p2 - p1 - 1)」の部分で、「1995」という数字の分を取り出しています。

その後ろに「半角スペース＋Songbirds - 機関車 (1995) jpPop」としています。

Set f = so.GetFolder(wa(i))

元のフォルダを取得しています。

f.Name = p

名前を変更しています。

Set f = Nothing

「Set ～」で使った、変数は、その使用後、「Nothing」で解放しておきます。

End If
Next

を、ドラッグ＆ドロップされたフォルダの数だけ繰り返しています。

Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

あとは、終了処理で、最後に「Finished!」と表示しています。

お礼

Prome_Linさん、
　　解説付きのコードの提供ありがとうございます。

サンプルでテストしてみました。

結果、エラーは出ないでMsgBox("Finished!")による完了が表示されましたが
思うような処理が行われずフォルダー名は何も変化が無くオリジナルのままでした。
（watabe007さんのスクリプトでは、ファイル名の変更が行われて書き換わりが行われました。）

回答No.3

watabe007

HohoPapa さん、有難うございました。
サブフォルダとして処理してやればいけますね
勉強させていただきました。m(_ _)m
Option Explicit
Dim arg, ObjFSO, folder, newName, str, n
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each arg In WScript.Arguments
For Each folder In objFSO.GetFolder(arg).SubFolders
newName = GetnewFName(folder.Name)
If newName <> "" Then
n = n + 1
str = str & "(" & n & ") " & folder.Name & vbCrLf & "↓" & vbCrLf & newName & vbCrLf
folder.Name = newName
End If
Next
Next
WScript.Echo str & vbCrLf & n & "件、変換できました。"
Set objFSO = Nothing

Function GetnewFName(strName)
Dim objRE, myMatches, strYear
Set objRE = CreateObject("VBScript.RegExp")
objRE.Pattern = "\(\d{4}\)"
Set myMatches = objRE.Execute(strName)
If myMatches.Count > 0 Then
strYear = Mid(myMatches(0).Value, 2, 4)
GetnewFName = strYear & " " & strName
If Left(strName, 5) = Left(GetnewFName, 5) Then GetnewFName = ""
End If
Set objRE = Nothing
End Function

お礼

watabe007さん,改造されたコードありがとうございます。

HohoPapaさんのアドバイスによりwatabe007さんが改造したコードでテストしました。

結果は、問題なく処理されました。
（処置するサンプル数が少ないのでもう少し多くのサンプルでテストする必要はあるかもしれません。）

回答No.2

HohoPapa

VBSがUniCodeに耐えられないのではなく
処理したいフォルダーをdrag-and-dropするときに
（DDEかな？、OLEかも？：ちょっと曖昧）
耐えられないんだろうと思います。

VBSで、かつ、drag-and-drop　を生かすのであれば
処理したいフォルダーではなく
その親フォルダーをdrag-and-dropする方法で対応するのは
いかがでしょうか？

むろん、親フォルダーに
UniCodeしか持たない文字を使わない前提です。

またせっかく手を加えるので、ついでに、
先頭4文字が数値で、そのあとに半角スペースのあるフォルダーは
対象外にしてみました。

これなら、親フォルダーに対して何度処理しても
子フォルダーは1回しか対象にならないはずです。

Option Explicit

Dim args
Set args = WScript.Arguments
Dim fso
set fso = createObject("Scripting.FileSystemObject")

Dim F1
Dim F2
Dim subfolder
Dim newName

For Each F1 in args
　Set F2 = fso.getFolder(F1)
　for each subfolder in f2.subfolders
　　newName = GetnewFName(subfolder.name)
　　If newName <> "" Then
　　　subfolder.Name = newName
　　End If
　next
next

Function GetnewFName(strName)
　Dim objRE
　Dim myMatches
　Dim strYear
　Set objRE = CreateObject("VBScript.RegExp")
　objRE.Pattern = "\(\d{4}\)"
　Set myMatches = objRE.Execute(strName)

　if ((Mid(strName,5,1) <> " ") and _
　　　(IsNumeric(Left(strName,4)) = False) and _
　　　(myMatches.Count > 0)) Then
　　　strYear = Mid(myMatches(0).Value, 2, 4)
　　　GetnewFName = strYear & " " & strName
　　Set objRE = Nothing
　end if
End Function

お礼

HohoPapaさん、レス有難うございます。

HohoPapaさんのアドバイスによりwatabe007が改造したコードでテストしました。
結果は、問題なく処理されました。
（処置するサンプル数が少ないのでもう少し多くのサンプルでテストする必要はあるかもしれません。）

しかし、HohoPapaさんのスクリプトでテストすると
　申し訳ないのですがHohoPapaさんのスクリプトは、エラーがでました。

添付の画像を参照下さい。
なお、コードにコメントアウトして説明を加えた結果、
28行目は、
　Set F2 = fso.getFolder(F1)
です。

補足

>HohoPapaさんのアドバイスによりwatabe007が改造したコードでテストしました。

watabe007さんの誤り。
呼び捨てにするような事になり、大変失礼しました。

回答No.1

watabe007

>The Blues Band – The Rooster Crowed(2018)
"–" がUnicodeらしくエラーが出たようです。
私自身VBSでUnicodeを扱ったことが無く(^_^;)
他の識者の回答をお待ちください。m(_ _)m

お礼

watabe007さん、引き続きてのアドバイスありがとうございます。

手詰まりの状態は変わりませんが、
　他の方のアドバイスを待ちたいと思います。