Sub 変更前ファイル名取得_区切り文字なし()
'---「Sub 変更前ファイル名取得_区切り文字なし」でしていること----
'①列幅設定
'②「b2」がブランクのときの処理
'③クリア処理
' Cells(5, 1)～Cells(Rows.Count, 6)
'④Call 書き出し処理3
' Call 書き出し処理4（フォルダ→ファイル」の順番に書き出し）
' 採番（１列目）
'-------------------------------------------------
'---①列幅を整える設定
Columns(2).ColumnWidth = 30
Columns(3).ColumnWidth = 2.7
Columns(4).ColumnWidth = 1.6
Columns(5).ColumnWidth = 30
Columns(6).ColumnWidth = 4.4
'-----------------
'---②「b2」がブランクのときの処理
If Range("b2").Value = "" Then
MsgBox "フォルダパスを入力または選択してください。": Exit Sub
End If
'---③クリア処理
Range(Cells(5, 1), Cells(Rows.Count, 6)).ClearContents
'---④変数「フォルダパス」にフルパスを入れる
フォルダパス = Range("b2").Value 'b2セルに取得したいフォルダパスを入力
Call 書き出し処理3
End Sub
Sub 書き出し処理3()
'******************************
'「フォルダパス」内のファイル名・フォルダ名を
'サブフォルダ→ファイル名の順番に変数「変更前ファイル等」に入れて、
'「Call 書き出し処理4」へ
'******************************
Dim i As Long '変更前フォルダの書き出しに使用
Dim 変更前ファイル等 As Object 'サブフォルダ・ファイルが入る
i = 5 '５行目から書き出し
'---フォルダ名書き出し（ループ）
'「変更前ファイル等」入るもの…「fso.GetFolder(フォルダパス).SubFolders」を使用することで
' b2セルに入力したフォルダ内のサブフォルダを入れている
For Each 変更前ファイル等 In fso.GetFolder(フォルダパス).SubFolders
Call 書き出し処理4(変更前ファイル等, i)
i = i + 1
Next
'---ファイル名書き出し（ループ）
'「変更前ファイル等」入るもの…「fso.GetFolder(フォルダパス).SubFolders」を使用することで
' b2セルに入力したフォルダ内のファイルを入れている
For Each 変更前ファイル等 In fso.GetFolder(フォルダパス).Files
Call 書き出し処理4(変更前ファイル等, i)
i = i + 1
Next
'---採番
Call 採番 '1列目に採番
End Sub
Sub 書き出し処理4(変更前ファイル等, i) '１行ずつの書き出し処理（サブフォルダ・ファイル）
Dim 拡張子 As String '拡張子格納用
'---変更前ファイル名等の書き出し
Cells(i, 2).Value = 変更前ファイル等.Name '書き出し処理（変更前）
'---変更後ファイル名等の書き出し
If GetAttr(変更前ファイル等.Path) = 16 Or GetAttr(変更前ファイル等.Path) = 48 Then 'フォルダの場合
Cells(i, 5).Value = 変更前ファイル等.Name '○○○○
Else 'ファイルの場合
Cells(i, 5).Value = fso.GetBaseName(変更前ファイル等) '○○○○
拡張子 = fso.GetExtensionName(変更前ファイル等) '拡張子のみ取得
If 拡張子 <> "" Then
Cells(i, 6).Value = "." & fso.GetExtensionName(変更前ファイル等) '"."+拡張子
End If
拡張子 = "" '拡張子のクリア処理
End If
End Sub