[[20240409173029]] 『VBAでファイルを変名』(joy) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『VBAでファイルを変名』(joy)

ファイル名をEXCELのVBAでチェックして保存処理が必要なのですが
過去記事を調べたら[]の2文字とshift-jisには存在するがUnicodeにしか存在しない文字列はVBAではファイル名として利用できないようです。
このような文字を「不適格文字」と呼ぶとすれば

フォルダーを指定しフォルダー内の複数ファイル名をチェックして「不適格文字」が存在すれば
半角のアンダーバー(_)に変換して変名するマクロを作成したいのですが
私には難しくコードが思いつきません。
教えていただけると助かります。

< 使用 Excel:Excel2021、使用 OS:Windows11 >


以下のように考えてみましたが
これで十分でしょうか ?

Sub Chek&Replace()

    Dim strFolder As String
    Dim strFile As String
    Dim strNewName As String

    ' フォルダパスを設定
    strFolder = "C:\Users\TAC_\test\" 

    ' フォルダ内のすべてのファイルをループ
    strFile = Dir(strFolder & "*.*")

    Do While strFile <> ""
        ' ファイル名に「?」が含まれているかチェック
        If InStr(strFile, "?") > 0 Then
            ' 「?」を「_」に置き換え
            strNewName = Replace(strFile, "?", "_")
            ' ファイル名を変更
            Name strFolder & strFile As strFolder & strNewName
        End If
        ' 次のファイルへ
        strFile = Dir
    Loop
End Sub

(joy) 2024/04/09(火) 17:56:02


[[20240331114249]]で質問された方ですね?

 ・既に存在しているファイルであれば、[]を含むExcelファイルはないはずです。

 ・「shift-jisには存在するがUnicodeにしか存在しない文字列」は
    Dir関数が?(U+3F)を含む文字列を返せば、それが不適格文字と判断できます。
    その文字列を"_"に置換すればいいのではないですか?
    (もともと?であることは、?がWindowsの禁止文字なのでありえません)

 こんな方針でトライされたらいかがですか?

 # と書いていたらコメントが。それで良い気がしますが、
 # 念入りに調べる必要があるかもしれません。
 # サロゲートペア文字回りで何かあるかもしれません。 
(xyz) 2024/04/09(火) 18:09:10

アドバイスありがとうございます。

少しコードを変えました。

以下で、「パスが見つかりません」とエラーがでました。
fso.MoveFile Source:=oldFilePath, Destination:=newFilePath

ローカルウインドウでは
oldFilePath : "D:\Kracrow\Catapilla ? Changes (Full Album) Rare Original Die Cut UK 1972 Vertigo Swirl Jazz Prog 2050.jpg"
newFilePath : "D:\Kracrow\Catapilla _ Changes (Full Album) Rare Original Die Cut UK 1972 Vertigo Swirl Jazz Prog 2050.jpg"

 ? は、「 – 」で =CODE()で調べたら32でした。

どこか?間違っているコードがありますか ?

Sub ChekReplace()

      Dim strFolder As String
      Dim strFile As String
      Dim strNewName As String
      Dim i As Long

      Dim fso As Object
      Set fso = CreateObject("Scripting.FileSystemObject")

      ' 既存のファイルパスと新しいファイルパスを定義
      Dim oldFilePath As String
      Dim newFilePath As String

      ' フォルダパスを設定
      strFolder = "D:\Kracrow\Catapilla\"

      ' フォルダ内のすべてのファイルをループ
      strFile = Dir(strFolder & "*.*")
      i = 2
      Do While strFile <> ""
            ' ファイル名に「?」が含まれているかチェック
            If InStr(strFile, "?") > 0 Then

                  'check用
                  Cells(i, "A") = strFile

                  ' 「?」を「_」に置き換え
                  strNewName = Replace(strFile, "?", "_")

                  oldFilePath = strFolder & strFile
                  newFilePath = strFolder & strNewName

                  ' Moveメソッドを使用してファイル名を変更
                  fso.MoveFile Source:=oldFilePath, Destination:=newFilePath

                  i = i + 1
            End If

            ' 次のファイルへ
            strFile = Dir
      Loop

      MsgBox "処理終了"

      Set fso = Nothing
End Sub
(joy) 2024/04/09(火) 19:39:49

 エラーの直接の原因は、ファイル名の取得にDir関数を使ってるからでしょうけど...

 >shift-jisには存在するがUnicodeにしか存在しない文字列はVBAではファイル名として利用できない
 まずこれを誤解してます。そんなことはありません。

 VBAの中で使える機能の中に、
 Dir関数等の「マルチバイト文字(Shift-JIS)向けに用意されている機能」と
 「ユニコード(UTF16)文字に対応している機能」があって、
 前者が「Unicodeにしか存在しない文字」を正しく認識出来ない。ってだけです。

 あと、ローカルウインドウ等のVBE上の文字列表示もマルチバイト文字です。

 一方[FileSystemObject]はユニコード文字で機能します。
 ローカルウインドウ上で一見「?」に見える文字も、VBE上で見てるから「?」に見えるだけです。
 (セル上やテキストボックス上に表示してみれば元の文字のままである事が確認出来ると思います)

 従って、
 「不適格文字を半角のアンダーバー(_)に変換しよう」という考え自体が
 本来ご自身がなさろうとしている事に適っているのか、今一度考え直してみても宜しいのではないかと思ってます。

(白茶) 2024/04/09(火) 20:39:30


 あり勝ちなパターンで憶測するなら
 「Catapilla – Changes (Full Album) Rare Original Die Cut UK 1972 Vertigo Swirl Jazz Prog £2050」
            ↑このハイフンっぽい奴とかね
U+2013 Unicode文字 0g0.org
https://0g0.org/unicode/2013/

(白茶) 2024/04/09(火) 21:01:30


 fso.MoveFileのOldfileは、置換する前のパス名を使わないとダメでしょう。
 fsoのFilesでファイルを列挙して、それらに一つ一つDir関数を当てて判定して、
 必要に応じて書き換えればいいでしょう。

 なお、
[[20240331114249]]で書いたように、
 | 単にVBAといってもどんな道具を使うかに依存して注意点は異なります。

 そしてまとめをきちんと引用しました。
 | ・ファイル名にUnicode文字を含むファイルの処理には、
 |    VBAのDir関数、Nameステートメント等を使わずにFileSystemObjectを使う必要がある

 ただし、考え方として狭い範囲に限定するために変名したいという前提も無いわけではない、
 と思いコメントしました。
 ご指摘のとおり、再考されるとよいでしょう。

(xyz) 2024/04/09(火) 21:04:01


白茶さん、xyzさん、アドバイスありがとうございます。

ユニコード(UTF16)文字に対応した[FileSystemObject]を利用してマクロを作成すれば
Dir関数と違ってwindowsで表示されるファイル名は、処理できると事なので

以下のようなコードを考えてみました。

エラー無くCells(i, "A")にファイル名が書き出されたので
    アンダーバーに変換するなどは考える必要は無いのですね

Option Explicit

Sub ChekReplace()

      Dim FolderPath As String
      Dim Folder As Object
      Dim File As Object
      Dim NewName As String
      Dim i As Long

      '参照設定しないで使用
      Dim fso As Object
      Set fso = CreateObject("Scripting.FileSystemObject")

      ' 既存のファイルパスと新しいファイルパスを定義
      Dim oldFilePath As String
      Dim newFilePath As String

      ' フォルダパスを設定
      FolderPath = "D:\modnaruemit"

      Set Folder = fso.GetFolder(FolderPath)

      i = 2
      For Each File In Folder.Files

                  'check用
                  Cells(i, "A") = File.Name
                  i = i + 1
      Next

      MsgBox "処理終了"

      Set fso = Nothing
End Sub

(joy) 2024/04/09(火) 21:52:43


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.