Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1558 / 76734

←次へ　｜　前へ→


	【80826】一応使ってるVBS

Jaka - 19/5/18(土) 1:19 -


	引用なし

	パスワード

ちょぼちょぼ修正して、今んところこれで動いているからこれで良いかってやつ。

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

2 hits

▼

【80810】フォルダ内のファイル名の変更についてです チマ 19/5/16(木) 6:44