[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『CSVファイル名の末尾に更新日付を付与するVBA』（たくと）
お世話になっております。
以下処理を実施するためのマクロをご教示いただきたく、、
・特定のフォルダを指定
・指定したフォルダにあるCSVファイルに対し、一括で以下の変更を実施
―ファイル名末尾に（数字）がついていれば削除 ※(2)とかです
―ファイルの更新日時を末尾に付与して更新
不勉強で申し訳ありませんが、よろしくお願いします。
＜ 使用 Excel：unknown、使用 OS：Windows10 ＞
Sub Sample()
Dim FSO As Object
Dim RE As Object
Dim f As Variant
Dim folderPath As String
Dim fPath As String
Dim fExt As String
Dim dtStr As String
'フォルダを選択（変数folderPathに入れる）
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = False
If Not .Show Then Exit Sub
folderPath = .SelectedItems(1)
End With
'抽出のために正規表現を使用する
Set RE = CreateObject("VBScript.RegExp")
RE.Pattern = "^.*\(\d+\)\.csv$" '正規表現定義
RE.IgnoreCase = True '大文字小文字区別なし
RE.Global = True '文字列全体を探す
'FileSystemObjectでフォルダ内のファイルを探す
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each f In FSO.GetFolder(folderPath).Files
fPath = f.Path 'ファイルパス
fExt = FSO.GetExtensionname(fPath) '拡張子
If StrConv(fExt, vbLowerCase) = "csv" Then '拡張子がcsvか調べる
If RE.test(fPath) Then '正規表現に一致するか調べる
'正規表現一致の場合
FSO.DeleteFile f.Path 'ファイルを削除
Else
'正規表現不一致の場合
dtStr = Format(f.DateLastModified, "yyyymmdd") 'ファイルの最終更新日をyyyymmdd形式に変換
f.Name = FSO.GetBaseName(fPath) & dtStr & "." & fExt 'ファイル名にyyyymmdd形式の日付を加える
End If
End If
Next
End Sub
練習課題と思い作成してみました。
ファイルを削除したり名前を変えたりしてしまうので実験環境をつくって試してください。
（下手の横好き） 2022/08/02(火) 17:46
# https://buralog.jp/powershell-folderbrowserdialog/
Add-Type -AssemblyName System.Windows.Forms
$FolderBrowser = New-Object System.Windows.Forms.FolderBrowserDialog -Property @{
RootFolder = "MyComputer"
Description = '選択したフォルダ内のCSVファイル名に更新日時を追加します'
}
if($FolderBrowser.ShowDialog() -eq [System.Windows.Forms.DialogResult]::OK){
# https://qiita.com/harryyuni/items/0d488cf2cf6b3f7f66f9
Set-Location $FolderBrowser.SelectedPath
Get-ChildItem "*.csv" -File | ForEach-Object {
$fn = $_.BaseName -replace '\([0-9]+\)$',''
$dt = $_.LastWriteTime.toString("yyyyMMddHHmmss")
Rename-Item $_.Name ($fn + $dt + $_.Extension)
}
}
（マナ） 2022/08/03(水) 19:48
（マナ） 2022/08/03(水) 19:52
マナさんへ ひょとして、powershell.exeに↑のコードを文字列として渡して実行しようとしている？ 簡単なコマンドレットの記述なら可能ですが、さすがに↑は無理と思います。 ↑のコードをps1ファイルとして保存して、それを実行するなら可能かと。 （コードの中身はチェックしてません） ↓はデスクトップに「test.ps1」として保存したファイルを実行する例です。
Sub test()
Dim ps1 As String
With CreateObject("Wscript.Shell")
ps1 = .specialfolders("desktop") & "\test.ps1"
.Run "powershell.exe -ExecutionPolicy RemoteSigned -File " & ps1, 0
End With
End Sub
（mayo2007） 2022/08/03(水) 20:56
こんなマクロで試していました。
おそらく '\([0-9]+\)$' とか (""yyyyMMddHHmmss"")
で躓いている気がしますが、
まだまだ理解できていいないことが多いので、
今はこれくらいにしておいて、おいおい勉強していきます。
Sub 失敗例()
Dim wsh As Object, fdg As FileDialog
Dim p As String
Dim plcy As String, cmd As String
Set wsh = CreateObject("wscript.shell")
Set fdg = Application.FileDialog(msoFileDialogFolderPicker)
If Not fdg.Show Then Exit Sub
p = "'" & fdg.SelectedItems(1) & "\*.csv'"
plcy = "-ExecutionPolicy RemoteSigned"
cmd = "Get-ChildItem " & p & " | " & _
"ForEach-Object { " & _
"$fn = $_.BaseName -replace '\([0-9]+\)$','' " & ";" & _
"$dt = $_.LastWriteTime.toString(""yyyyMMddHHmmss"")" & ";" & _
"Rename-Item $_.FullName ($fn + $dt + $_.Extension)}"
wsh.Run "powershell " & plcy & " -Command " & cmd, 0, True
Debug.Print cmd '★ps1ファイルの右クリック「PowerShellで実行」では成功
Debug.Print Len(cmd) '★文字数制限ではなさそう
End Sub
（マナ） 2022/08/04(木) 12:22
＞ ―ファイル名末尾に（数字）がついていれば削除 ※(2)とかです
ファイル自体の削除、それともファイル名から（数字）を削除でしょうか
（マナ） 2022/08/04(木) 12:24
>(""yyyyMMddHHmmss"")
" をエスケープするとうまくいくみたいですよ
Sub test()
Dim wsh As Object, fdg As FileDialog
Dim p As String
Dim plcy As String, cmd As String
Set wsh = CreateObject("wscript.shell")
Set fdg = Application.FileDialog(msoFileDialogFolderPicker)
If Not fdg.Show Then Exit Sub
p = "'" & fdg.SelectedItems(1) & "\*.csv'"
plcy = "-ExecutionPolicy RemoteSigned"
cmd = "Get-ChildItem " & p & " | " & _
"ForEach-Object { " & _
"$fn = $_.BaseName -replace '\([0-9]+\)$','' " & ";" & _
"$dt = $_.LastWriteTime.toString('""yyyyMMddHHmmss'"") " & ";" & _
"Rename-Item $_.FullName ($fn + $dt + $_.Extension)}"
wsh.Run "powershell " & plcy & " -Command " & cmd, 0, True
End Sub
（´・ω・`） 2022/08/04(木) 13:03
あ、いや
"$dt = $_.LastWriteTime.toString('yyyyMMddHHmmss') " & ";" & _
でいいみたいですね
（´・ω・`） 2022/08/04(木) 13:13
('yyyyMMddHHmmss')で、期待通りにリネームできました。
中途半端な回答になるところでしたが、なんとか格好はつきました。
（マナ） 2022/08/04(木) 20:25
Sub Sample()
Dim FSO As Object
Dim RE As Object
Dim folderPath As String
Dim fileName As String
Dim fileExtension As String
Dim date8String As String
Dim NewFileName As String
Dim f As Variant
'フォルダを選択（変数folderPathに入れる）
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = False
If Not .Show Then Exit Sub
folderPath = .SelectedItems(1)
End With
'抽出のために正規表現を使用する
Set RE = CreateObject("VBScript.RegExp")
RE.Pattern = "\(\d+\)$" '正規表現設定
RE.IgnoreCase = True '大文字小文字区別なし
RE.Global = True '文字列全体を探す
'FileSystemObjectでフォルダ内のファイルを探す
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each f In FSO.GetFolder(folderPath).Files
fileName = FSO.GetBaseName(f.Path) 'ファイル名（拡張子抜き）
fileExtension = FSO.GetExtensionName(f.Path) '拡張子
If StrConv(fileExtension, vbLowerCase) = "csv" Then '拡張子がcsvか調べる
If RE.Test(fileName) Then '正規表現に一致するか調べる
'一致の場合
date8String = Format(f.DateLastModified, "yyyymmdd") 'ファイルの最終更新日をyyyymmdd形式に変換
fileName = RE.Replace(fileName, date8String) 'ファイル名を変更(ファイル名の(数字)をyyyymmdd形式の日付に変更)
NewFileName = fileName & "." & fileExtension '新ファイル名を定義
If Dir(folderPath & "\" & NewFileName) = "" Then '同名ファイルの有無確認
f.Name = NewFileName '新ファイル名に変更
End If
End If
End If
Next
End Sub
皆さんのやり取りから先日の答案では問題有りと判断し修正を試みました。
（下手の横好き） 2022/08/05(金) 10:57
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.