[[20231001074125]]　『指定文字以降の文字列を削除したファイル名に変名』（メタボ）　ページの最後に飛ぶ

『指定文字以降の文字列を削除したファイル名に変名』（メタボ）

指定フォルダー内のファイル名中に指定文字列が存在する場合は、
指定文字以降の文字列（指定文字列を含む）を削除したファイル名に変名するVBAのコードを
以下のようなコードで想定してみましたが「strNewFile =」の部分が判りません。

アドバイスをお願いします。

’--------------------
又、現在は削除予定文字列の候補が1個ですが、複数ある場合
strSearchだけを変えた同じようなコードを必要数作成する事はできますが
コード内で複数のstrSearchを指定するようなコードがあれば教えてください。

（一つのファイル名に指定するstrSearchが複数存在する事はありません。
必ず一つあるか、無いかの2択です。）

 Sub TargetFileRename()
      Dim strPath As String
      Dim strFile As String
      Dim strNewFile As String
      Dim strSearch As String
      Dim intPos As Integer

      '指定フォルダのパスを設定
      strPath = "C:\Test\"

      '検索する文字列を設定
      strSearch = "Temp"

      '指定フォルダ内のファイルをループ処理
      strFile = Dir(strPath & "*.*")
      Do While strFile <> ""
            'ファイル名に検索文字列が含まれる場合は、指定文字以降を削除したファイル名に変更
            intPos = InStr(strFile, strSearch)
            If intPos > 0 Then
                  '変名予定のファイル名
                  ’strNewFile =
                  Name strPath & strFile As strPath & strNewFile
            End If
            strFile = Dir
      Loop
 End Sub

＜使用 Excel：Excel2021、使用 OS：Windows11 ＞

＞「strNewFile =」の部分が判りません。

ファイル名変更処理は別 function にして、Replace 関数を使うのがよいかと。変更後のファイル名を戻り値にして、呼び出し元に戻ってから Name する。

＞コード内で複数のstrSearchを指定する

数にもよりますが、2,3個なら続けて Replace する。いちいち InStr 使って対象文字列が含まれるかのチェックは要らないし。数が多けりゃ当然 For で回す。
（xlg） 2023/10/01(日) 08:12:28

＞＞ファイル名変更処理は別 function にして、Replace 関数を使うのがよいかと。

そういわれても、それが解らないから質問しています。

＞＞2,3個なら続けて Replace する。
＞＞いちいち InStr 使って対象文字列が含まれるかのチェックは要らないし。
＞＞数が多けりゃ当然 For で回す。

この点は、自分で何とかなりそうです。

（メタボ） 2023/10/01(日) 08:18:58

考えて以下のように考えてみましたが
アドバイスあればお願いします。

 Sub TargetFileRename()
      Dim strPath As String
      Dim strFile As String
      Dim strNewFile As String
      Dim strSearch As String
      Dim intDelimiterPosition As Integer
      Dim intPos As Integer
      Dim ExtensionName As String
      Dim fso As Object

      Set fso = CreateObject("Scripting.FileSystemObject")

      '指定フォルダのパスを設定
      strPath = "C:\Test\"

      '検索する文字列を設定
      strSearch = "temp"

      '指定フォルダ内のファイルをループ処理
      strFile = Dir(strPath & "*.*")

      Do While strFile <> ""
            'ファイルの拡張子取得
            ExtensionName = fso.GetExtensionName(strFile)

            'ファイル名に検索文字列が含まれる場合は、指定文字以降を削除したファイル名に変更
            intPos = InStr(strFile, strSearch)
            If intPos > 0 Then
                  strNewFile = Left(strFile, intPos - 1) & ". " & ExtensionName
                  Name strPath & strFile As strPath & strNewFile
            End If

            strFile = Dir

      Loop
 End Sub

（メタボ） 2023/10/01(日) 08:51:25

＞指定文字以降の文字列（指定文字列を含む）を削除したファイル名に変名

　という部分を読み違えていました。Replace は使えませんね。こんな感じでどうでしょ。指定文字列はとりあえずふたつ。

　厳密にはリネームした時に同じ名前のが無いかとかチェックは要るかも。

 Sub TargetFileRename()
    Dim strPath As String
    Dim strFile As String
    Dim strNewFile As String
    Dim intDelimiterPosition As Integer
    Dim extensionName As String
    '指定フォルダのパスを設定
    strPath = "C:\Test\"

    '指定フォルダ内のファイルをループ処理
    strFile = Dir(strPath & "*.*")
    Do While strFile <> ""
        strNewFile = newFileName(strFile)
        If strNewFile <> "" Then
            Name strPath & strFile As strPath & strNewFile
        End If
        strFile = Dir
    Loop
 End Sub

 Private Function newFileName(file_name As String) As String
    'ファイルの拡張子取得(File System Object を使うまでもない)
    Dim ext As String: ext = Mid(file_name, InStrRev(file_name, "."))
    Dim kw As Variant
    For Each kw In Array("temp", "keyword")
        Dim intPos As Long: intPos = InStr(file_name, kw)
        If intPos <> 0 Then
            '拡張子ごと切り捨ててからまた拡張子を連結する
            newFileName = Left(file_name, intPos - 1) & ext
        End If
    Next
 End Function

（xlg） 2023/10/02(月) 08:44:53

　不要な以下のふたつの宣言を削除し忘れました。

＞ Dim intDelimiterPosition As Integer
＞ Dim extensionName As String

（xlg） 2023/10/02(月) 08:46:59

コメント返信：

[ 一覧(最新更新順) ]

[[20231001074125]] 『指定文字以降の文字列を削除したファイル名に変名』（メタボ） ページの最後に飛ぶ

[[20231001074125]]　『指定文字以降の文字列を削除したファイル名に変名』（メタボ）　ページの最後に飛ぶ