『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
・既に存在しているファイルであれば、[]を含む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
ユニコード(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.