ファイル情報の取得方法

Sub Sample3()

    Dim f As Object, cnt As Long
    
    cnt = 1
    
    'A列に作成日時
    Cells(1, 1) = "作成日時"
    
    'B列にファイル名称
    Cells(1, 2) = "ファイル名"
    
    'C列にファイルサイズ
    Cells(1, 3) = "ファイルサイズ"
    
    Cells(1, 4) = "保存場所"
    
    With CreateObject("Scripting.FileSystemObject")
        
        For Each f In .GetFolder("C:\Users\Desktop\***").Files
            
            '2行目以降に、フォルダ内のファイルの取得結果を記載する
            cnt = cnt + 1
            
            Cells(cnt, 1) = f.DateCreated
            
            Cells(cnt, 2) = f.Name
            
            Cells(cnt, 3) = f.Size
            
            Cells(cnt, 4) = f.Path
        
        Next f
    
    End With

End Sub

ブックをコピーするVBA

Sub ブック作成()
    Dim 元ブック As Workbook
    Dim 元シート As Worksheet
    Dim 対象シート As Worksheet
    Dim 新ブック As Workbook
    Dim ファイルパス As String
    
    ' 元のブックを設定
    Set 元ブック = ThisWorkbook
    
    ' シート6のA1セルの値を取得
    Dim 新ブック名 As String
    新ブック名 = 元ブック.Sheets(1).Range("A1").value
    
    ' 新しいブックを作成
    Set 新ブック = Workbooks.Add
    Set 対象シート = 新ブック.Sheets(1)
    
    ' 元のシートの内容を新しいブックにコピー
    For Each 元シート In 元ブック.Sheets
        If 元シート.Index <> 1 Then ' シート1以外の場合にコピー
            元シート.Cells.Copy 対象シート.Cells
            ' 次のシートに移動
            If 元シート.Index < 元ブック.Sheets.Count Then
                Set 対象シート = 新ブック.Sheets.Add(After:=対象シート)
            End If
        End If
    Next 元シート
    
    ' 新しいブックの名前を設定して保存
    新ブック.SaveAs 元ブック.Path & "\" & 新ブック名 & ".xlsx", FileFormat:=51 ' xlsxフォーマットを指定
    
    ' 新しいブックを閉じる
    新ブック.Close SaveChanges:=True
    
    ' メッセージを表示
    MsgBox "新しいブックが作成されました。", vbInformation
    
End Sub

フォルダを作成するVBA

Sub CreateFoldersBasedOnCellValue()

    Dim ParentFolderPath As String

    ParentFolderPath = ThisWorkbook.Path ' ファイルと同じディレクトリのパスを取得
    
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("Sheet6") ' シート名を適切に変更してください
    
    Dim FolderName As String

    FolderName = ParentFolderPath & "\" & ws.Range("A1").value ' A1セルの値をフォルダ名として使用
    
    ' フォルダがなければ作成
    If Dir(FolderName, vbDirectory) = "" Then

        MkDir FolderName

    End If

End Sub

ダブルクリックでコピペ

フォルダからファイルを取得

Sub Sample3()

    Dim f As Object, cnt As Long
    
    
    cnt = 1
    
    'A列に作成日時
    Cells(1, 1) = "作成日時"
    
    'B列にファイル名称
    Cells(1, 2) = "ファイル名"
    
    'C列にファイルサイズ
    Cells(1, 3) = "ファイルサイズ"
    
    With CreateObject("Scripting.FileSystemObject")
        
        For Each f In .GetFolder("C:\Users\Desktop\テスト").Files
            
            '2行目以降に、フォルダ内のファイルの取得結果を記載する
            cnt = cnt + 1
            
            Cells(cnt, 1) = f.DateCreated
            
            Cells(cnt, 2) = f.Name
            
            Cells(cnt, 3) = f.Size
            
        
        Next f
    
    End With

End Sub