Excel VBA質問箱 IV

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

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


29 / 13315 ツリー ←次へ | 前へ→

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

【80826】一応使ってるVBS Jaka 19/5/18(土) 1:19 発言[未読]
【80827】ああ、↑ファイル名によってはエラーになり... Jaka 19/5/18(土) 1:26 発言[未読]
【80828】板汚し、更にすみません。 Jaka 19/5/18(土) 2:21 発言[未読]

【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

【80827】ああ、↑ファイル名によってはエラーにな...
発言  Jaka  - 19/5/18(土) 1:26 -

引用なし
パスワード
   ああ、↑ファイル名によってはエラーになります。

エラー処理考えるのが面倒何で、エラーになったらファイル名や文字数が合って無かったのかとか割り切って使ってます。

【80828】板汚し、更にすみません。
発言  Jaka  - 19/5/18(土) 2:21 -

引用なし
パスワード
   >変えた名前のファイルも新たに拾ってしまうから

これ、右側の文字に関しては当てはまらなかったような?
すみません。

29 / 13315 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free