Excel VBA質問箱 IV

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

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


41 / 13327 ツリー ←次へ | 前へ→

【80810】フォルダ内のファイル名の変更についてです チマ 19/5/16(木) 6:44 質問[未読]
【80811】Re:フォルダ内のファイル名の変更について... γ 19/5/16(木) 7:35 回答[未読]
【80818】Re:フォルダ内のファイル名の変更について... γ 19/5/16(木) 23:42 発言[未読]
【80829】Re:フォルダ内のファイル名の変更について... γ 19/5/18(土) 8:56 発言[未読]
【80825】Re:フォルダ内のファイル名の変更について... Jaka 19/5/18(土) 1:00 発言[未読]
【80826】一応使ってるVBS Jaka 19/5/18(土) 1:19 発言[未読]
【80827】ああ、↑ファイル名によってはエラーになり... Jaka 19/5/18(土) 1:26 発言[未読]
【80828】板汚し、更にすみません。 Jaka 19/5/18(土) 2:21 発言[未読]

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

引用なし
パスワード
   フォルダ内のファイル名の変更が必要になって次のようなマクロを作成しました

Sub ファイル名変更()
Dim fso As New FileSystemObject
Dim myfile As file
For Each myfile In fso.GetFolder("F:\新しいフォルダー").Files
  If InStr(myfile.Name, "☆☆") <> 0 Then
   fso.MoveFile myfile, myfile.ParentFolder.Path & "\" & Mid(myfile.Name, InStr(myfile.Name, "☆☆") + 2, 8) & "_" & myfile.Name
  End If
Next myfile

End Sub

"F:\新しいフォルダー"の中には
"F:\新しいフォルダー\1234567☆☆1234567891.pdf"
"F:\新しいフォルダー\1234567☆☆12345678912.pdf"
の2つのファイルがありますがマクロの実行結果は

"F:\新しいフォルダー\12345678_12345678_1234567☆☆1234567891.pdf"
"F:\新しいフォルダー\12345678_12345678_1234567☆☆12345678912.pdf"
と書き換わってしまいます。

私はそれぞれ
"F:\新しいフォルダー\12345678_1234567☆☆1234567891.pdf"
"F:\新しいフォルダー\12345678_1234567☆☆12345678912.pdf"
とファイル名を変更したいのですがfor each next で余分にループして思っているファイル名に変更できません。

 いろいろ調べましたがどうしてもわからないので教えてください。
 

【80811】Re:フォルダ内のファイル名の変更につい...
回答  γ  - 19/5/16(木) 7:35 -

引用なし
パスワード
   変更後の名前である
myfile.ParentFolder.Path & "\" & Mid(myfile.Name, InStr(myfile.Name, "☆☆") + 2, 8) & "_" & myfile.Name
について、それぞれの文字列要素
myfile.ParentFolder.Path
Mid(myfile.Name, InStr(myfile.Name, "☆☆") + 2, 8)
myfile.Name
がどのような内容か、ご自分で観察する必要があるのではないですか?
デバッグ手法をおさらいしてください。

【80818】Re:フォルダ内のファイル名の変更につい...
発言  γ  - 19/5/16(木) 23:42 -

引用なし
パスワード
   プロシージャの一回の実行で同一ファイルに対し
処理が繰り返されることは無いはずです。
なにか操作ミスで二回実行しているのではないかと思います。

【80825】Re:フォルダ内のファイル名の変更につい...
発言  Jaka  - 19/5/18(土) 1:00 -

引用なし
パスワード
   >For Each myfile In fso.GetFolder("F:\新しいフォルダー").Files

これねえ、変えた名前のファイルも新たに拾ってしまうから、
最初に全ファイル名を配列に入れて、配列に入れたファイル名を使った方が良いと思います。

vbsで長いこと気付かづ苦労した。

【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 -

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

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

【80829】Re:フォルダ内のファイル名の変更につい...
発言  γ  - 19/5/18(土) 8:56 -

引用なし
パスワード
   以下のようなコードでステップ実行をするとわかりますが、
getdataが呼ばれるのは一回だけですから、
更新の結果がさらに入力に影響することはあり得ないと思います。

したがって、
一回のループで、1つのファイルに更新が二回されることはないはずです。

Function getdata() As Variant
  Dim fso As New FileSystemObject
  Set getdata = fso.GetFolder("F:\新しいフォルダー").Files
End Function

Sub ファイル名変更()
  Dim myfile As file
  For Each myfile In getdata
    Debug.Print myfile.Name
  Next myfile
End Sub

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