VBA ファイル名のフォルダ作成、そのホルダに移動

質問

以下のファイルがフォルダにあります。
そのフォルダにエクセル　ファイルがあります。
VBAにてファイルを整理したいので、コード作成をお願いできますか。

ファイル名から20250101というフォルダをファイルがある場所に作成し、同じ日付のファイルをそのフォルダに移動する。
20250102フォルダ作成、以下同じ
ファイルがなくまるまで続ける。

存在するファイル
IMG_2025-01-01-18-33-15-155
IMG_2025-01-01-19-33-15-155
IMG_2025-01-02-18-33-15-155
IMG_2025-01-03-18-33-15-155
・
・
さらにたくさんファイルがある。

面倒でとても出来ないという内容でしたら、IMG_2025-01-01、IMG_2025-01-02、・・・という名前のフォルダを作るコードだけお教えください。

回答No.1

SI299792 · ベストアンサー

B1に親フォルダ名
B2にファイル名頭文字を入れて実行して下さい。
Option Explicit
'
Sub Macro1()
　　Dim FileName As String
　　Dim Start As Integer
　　Dim PathName As String
'
　　FileName = Dir([B1] & "\" & [B2] & "*.*")
　　Start = Len([B2]) + 1
'
　　If FileName = "" Then
　　　　MsgBox "フォルダ又はファイルが見つかりません", vbCritical
　　End If
'
　　Do While FileName > ""
　　　　PathName = Mid(FileName, Start, 10)
　　　　PathName = Replace(PathName, "-", "")
　　　　On Error Resume Next
　　　　MkDir [B1] & "\" & PathName
　　　　On Error GoTo 0
　　　　Name [B1] & "\" & FileName As _
　　　　　　[B1] & "\" & PathName & "\" & FileName
　　　　FileName = Dir
　　Loop
End Sub

\ はVBA 上では半角￥になります。

お礼

回答ありがとうございます。 全て期待通りに動きました。

Powered by GRATICA