初心者でも出来る攻略法！
機種別最新攻略法、雑誌以上の情報公開中。
無料で攻略法も進展中！

フォルダをアルファベット順に仕訳

フォルダが増えて分割して管理したいとき、アルファベット順にほかのフォルダにコピーします
大量フォルダを、Aで始まるフォルダ、Bで始まるフォルダ・・・にコピーします
■Windows/XPで動作確認済み
■使いかた
1.拡張子.vbsで適当なファイルを作成する
2.このvbsファイルをエディタで開く
3.下記ソーズをコピー、上記で開いた.vbsのファイルに貼り付ける
4.ソース中の下記2行が私が実行したものになっているので書き換える
sourcepath="DVD_IDOL2" ←コピー元 destpath="DVD_IDOLM" ←コピー先 5.保存・終了する
6.コピー先のフォルダを作成する 7.このvbsファイルを実行（ダブルクリック）→コピー先のフォルダ下にA,B,･･･,Zのフォルダを作成し、アルファベット順にそれぞれのフォルダにコピーされます

■ソース
sourcepath="DVD_IDOL2" destpath="DVD_IDOLM" copy_ok=0 copy_ng=0 Set kensuu = CreateObject("Scripting.Dictionary") Set err_kensuu = CreateObject("Scripting.Dictionary") Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Set errText = objFSO.OpenTextFile("err.txt",2,true) for i=1 to 26 ' for j=0 to 255 ' if chr(j)="A" then ' if MsgBox(j, VbOKCancel, "WS") = vbOK Then WScript.Quit ' end if ' next strParent=destpath & "\" & chr(i+64) 'if MsgBox(strParent, VbOKCancel, "WS") = vbOK Then WScript.Quit if Not objFSO.FolderExists(strParent) Then objFSO.CreateFolder(strParent) End If next set folder = objFSO.GetFolder(sourcepath) for each a in folder.SubFolders pre=UCase(left(a.name,1)) preStr= pre & "\" 'if MsgBox(asc(left(pre), VbOKCancel, "WS") = vbOK Then WScript.Quit on error resume next objFSO.CopyFolder sourcepath & "\" & a.name , destpath & "\" & preStr & a.name,false if err.description<>"" then errText.WriteLine a.name & ":" & err.description err.clear if err_kensuu.exists(pre)=false then err_kensuu.add pre,"1" else kensuu_w=err_kensuu.item(pre) kensuu_w=kensuu_w+1 err_kensuu.remove(pre) err_kensuu.add pre,kensuu_w end if copy_ng=copy_ng+1 else if kensuu.exists(pre)=false then kensuu.add pre,"1" else kensuu_w=kensuu.item(pre) kensuu_w=kensuu_w+1 kensuu.remove(pre) kensuu.add pre,kensuu_w end if copy_ok=copy_ok+1 end if on error goto 0 Next errText.WriteLine "copy_ok=" & copy_ok errText.WriteLine "copy_ng=" & copy_ng if copy_ok>0 then for each a in kensuu errText.WriteLine a & ":" & kensuu.item(a) & "件" next end if if copy_ng>0 then for each a in err_kensuu errText.WriteLine "err " & a & ":" & err_kensuu.item(a) & "件" next end if errText.close

■免責うんぬん
・本VBSによる使用者の損害どうのこうの補償は作成者は一切関知しません
　使用者の責においてご利用ください
質問・要望はこちらから
こちらのオークションでプログラミングの書籍を出品してます