【殴り書き】しごとでつかうプログラム【コード】

sigre.hatenablog.jp

コレにファイル名の全角数字をとってきてファイル名の頭にくっつける機能を付けたやつ。

バグが無い自信がない。

そしてメソッドに分割できないのつらすぎる。

Option Explicit
'ドロップされたパスを取得
Dim myArray
Dim objFSO, myFile, objShell, objSc, objFolder
Dim objCopiedFol, objFileInFol, objFile, objRE, objMatch 'As object
Dim openPath, linkPath, copiedFolPath, numberStr 'As String
Dim ary

Set myArray = WScript.Arguments 

'ファイルかどうかの判断用にオブジェクトを作成
Set objFSO = CreateObject("Scripting.FileSystemObject")

'ドロップされた物の判断
if objFSO.FolderExists(myArray(0)) then
	'ディクトリの場合
	openPath = myArray(0)
Else

	'ディレクトリ以外の場合
	if objFSO.GetExtensionName(myArray(0)) <> "lnk" then
		'ファイルの場合、その親のディレクトリパスを取得
		Set myFile = objFSO.Getfile(myArray(0))
		openPath = myFile.ParentFolder
	Else
		'ショートカットの場合
		'それぞれのオブジェクトを作成
		Set objShell = WScript.CreateObject("WScript.Shell")
		Set objSc = objShell.CreateShortcut(myArray(0))

		'パスを取得
		openPath = objSc.TargetPath

		'ショートカット先がファイルか判断
		If objFSO.FileExists(openPath) Then
			'ファイルの場合、その親のディレクトリパスを取得
			Set myFile = objFSO.Getfile(openPath)
			openPath = myFile.ParentFolder
		End If
	End If
End If

'フォルダ作成
copiedFolPath = openPath & "\temp\"
if Not objFSO.FolderExists(copiedFolPath) then
	Set objCopiedFol = objFSO.CreateFolder(copiedFolPath)
End If

Set objFolder = objFSO.GetFolder(openPath)

'正規表現
Set objRE = CreateObject("VBScript.RegExp")



For Each objFileInFol In objFolder.Files

	With objRE

	    .Pattern = "[０-９]+"
	    .IgnoreCase = True
	    .Global = True

	     Set objMatch = objRe.Execute(objFileInFol.Name)
		if (objMatch.Count > 0) Then
			numberStr = objMatch.Item(0).Value & "_"
		Else 
			numberStr = ""
		End If
		'msgbox objMatch.Item(0)
	End With

	'msgbox objFileInFol.Name
	if objFSO.GetExtensionName(objFileInFol.Path) <> "lnk" then
		'ファイルの場合
		objFSO.CopyFile openPath & "\" & objFileInFol.Name, copiedFolPath & numberStr & objFileInFol.Name

	Else
		'ショートカットの場合
		'それぞれのオブジェクトを作成
		'msgbox openPath & "\" & objFileInFol.Name
		Set objShell = WScript.CreateObject("WScript.Shell")
		Set objSc = objShell.CreateShortcut(openPath & "\" & objFileInFol.Name)

		'パスを取得
		linkPath = objSc.TargetPath
		'msgbox linkPath
		'ショートカット先がファイルか判断
		If objFSO.FileExists(linkPath) Then
			'ファイルの場合
			ary = Split(linkPath, "\")
			objFSO.CopyFile linkPath, copiedFolPath & numberStr & ary(UBound(ary))
		End If
	End If
Next

Set objRE = Nothing
msgbox "完了"

仕事で使うコードですが、特に権利とか気にしないです。