|
ちょぼちょぼ修正して、今んところこれで動いているからこれで良いかってやつ。
NowTime = Now()
'VBSファイルのあるフォルダ
Set FSO= CreateObject("Scripting.FileSystemObject")
FPth = FSO.getparentfoldername(wscript.scriptfullname)
'Kakucyoshi = ".png"
Kakucyoshi = ".jpg"
'Kakucyoshi = ".ts"
ALLFCnt = FSO.GetFolder(FPth).Files.Count
'msgbox ALLF_Cnt
'VBSでは、TB(1 to 5)とか、配列の添え字を指定できない。
ReDim ALLF_TB(FSO.GetFolder(FPth).Files.Count)
For Each FFF In FSO.GetFolder(FPth).Files
If LCase(FSO.GetExtensionName(FFF.Name)) = Mid(Kakucyoshi,2) Then
'ALLF_TB(cnt) = FSO.GetBaseName(FFF.Name) '拡張子なしのファイル名
ALLF_TB(cnt) = FFF.Name
if saisyo_mojisuu > len(FFF.Name) then
saisyo_mojisuu = len(FFF.Name)
elseif saidai_mojisuu < len(FFF.Name) then
saidai_mojisuu = len(FFF.Name)
end if
'msgbox ALLF_TB(cnt)
'WScript.Quit
cnt = cnt + 1
End If
Next
'25
KK = inputbox(Kakucyoshi & vblf & vblf & "消去文字数を入力してください","左文字消し",3)
if not isnumeric(KK) then
msgbox "数字以外",,"中止"
Set FSO = Nothing
Erase ALLF_TB
WScript.Quit
elseif KK = "" then
msgbox "キャンセル",,"中止"
Set FSO = Nothing
Erase ALLF_TB
WScript.Quit
end if
'文字の長さを比較
'if saidai_mojisuu - KK - len(Kakucyoshi) < len(cnt) then
' msgbox ""
'end if
'35
'For Each FFF In ALLF_TB 'これだと空っぽ
On Error Resume Next
For i = 0 to cnt - 1
'msgbox FPth & "\" & ALLF_TB(i)
'exit for
Set objFile = FSO.GetFile(FPth & "\" & ALLF_TB(i))
NewNm = Mid(ALLF_TB(i),KK + 1)
'msgbox objFile & vblf & NewNm
if Len(NewNm) < Len(Kakucyoshi) + 1 Then
Msgbox "削除後の名前に異常あり"& VBlf & VBlf & _
"削除後の名前 " & NewNm & vblf & _
"古い名前 " & ALLF_TB(i), _
vbExclamation,"左文字削除の異常"
WScript.Quit
Else
'if NowTime <= objFile.DateLastModified then
' msgbox objFile & " は、名前変更後のファイル。"
'end if
'msgbox "更新日時:" & objFile.DateLastModified
objFile.Name = NewNm
if err.number <> 0 then
msgbox "名前変更エラー 元ファイル名" & VBLF &_
ALLF_TB(i) & VBLF & "変更後ファイル名 " & NewNm
WScript.Quit
End if
Ct = Ct + 1
'if Ct >=10 then exit for
End if
Next
Set FSO = Nothing
Set objFile = Nothing
Erase ALLF_TB
msgbox Kakucyoshi & vblf & vblf & "左数文字消し2 「" & KK & "」 文字で終わりました。" & _
vblf & vblf & Ct & " 個",,"終了"
WScript.Quit
|
|