[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイル名の取得』（いちご）
ファイルの管理、確認するのに一覧を作ってます
自動でやりたくてサンプルコードを見つけました
セルに書き出すにはどうやったらいいですか？
フォルダパスはB2にファイル一覧はB5セルから書き出したいです
'--- 指定フォルダ内に含まれるすべてのファイルパスを取得 ---'
Public Sub GetAllFilePath()
'--- ファイル一覧を取得したいフォルダのパス ---'
Dim folderPath As String
folderPath = "[フォルダパス]"
'--- サブフォルダのパス一覧を取得 ---'
Dim folderList As Variant
folderList = GetFolderPath(folderPath)
'--- 指定フォルダのファイルパスを取得
Dim fileList() As String
fileList = GetFileListFso(folderPath)
'--- ファイル数を保存する変数 ---'
Dim n As Long
Dim m As Long
'--- サブフォルダのファイルパスを取得し順次結合する
Dim tmpList() As String
Dim i As Long
Dim s As Variant
For Each s In folderList
tmpList = GetFileListFso(CStr(s))
n = GetArrayLength(fileList)
m = GetArrayLength(tmpList)
If (0 < n + m) Then
ReDim Preserve fileList(1 To n + m)
For i = 1 To m
fileList(n + i) = tmpList(i)
Next i
End If
Next s
End Sub
'--- １次元配列の要素数を取得する関数 ---'
Public Function GetArrayLength(vList As Variant) As Long
Dim n As Long
If (IsEmptyArray(vList)) Then
n = 0
Else
n = UBound(vList)
End If
GetArrayLength = n
End Function
'--- フォルダに含まれる（サブフォルダ除く）のファイル一覧を取得する関数 ---'
Public Function GetFileListFso(folderPath As String) As String()
'--- ファイルシステムオブジェクト ---'
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'--- ファイル数を格納する変数 ---'
Dim n As Variant
n = fso.GetFolder(folderPath).Files.Count
If (0 < n) Then
'--- ファイル名を格納する配列 ---'
Dim str() As String
ReDim str(1 To n)
'--- ファイル名を格納 ---'
i = 1
Dim f As Object
For Each f In fso.GetFolder(folderPath).Files
str(i) = f.Path
i = i + 1
Next f
End If
GetFileListFso = str
End Function
'--- サブフォルダを再帰的に取得する関数 ---'
Public Function GetFolderPath(folderPath As String) As String()
'--- ファイルシステムオブジェクト ---'
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'--- フォルダ数を格納する変数 ---'
Dim n As Variant
n = fso.GetFolder(folderPath).SubFolders.Count
If (0 < n) Then
'--- フォルダパスを格納する配列 ---'
Dim str() As String
ReDim str(1 To n)
'--- フォルダパスを格納 ---'
Dim i As Long
Dim j As Long
Dim m As Long
i = 1
Dim strTmp() As String
'フォルダパスを指定してすべてのサブフォルダを取得
Dim f As Object
For Each f In fso.GetFolder(folderPath).SubFolders
str(i) = f.Path
strTmp = GetFolderPath(str(i)) '再帰的呼び出し
If (Not IsEmptyArray(strTmp)) Then
m = UBound(strTmp, 1)
Else
m = 0
End If
'サブフォルダ内にさらにフォルダがあればその分だけ配列を拡張
n = UBound(str, 1)
ReDim Preserve str(1 To n + m)
For j = 1 To m
str(i + j) = strTmp(j)
Next j
i = i + m + 1
Next f
End If
GetFolderPath = str
End Function
'--- 配列が空かどうかを判定する関数 ---'
Public Function IsEmptyArray(arrayTmp As Variant) As Boolean
On Error GoTo ERROR_
If (0 < UBound(arrayTmp, 1)) Then
IsEmptyArray = False
End If
Exit Function
ERROR_:
IsEmptyArray = True
End Function
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
なお、再帰処理の話は別にして↓が参考になると思いますので確認してみてはどうでしょうか？
http://officetanaka.net/excel/vba/file/file07.htm
再帰処理も含めてみるなら↓かも？
http://officetanaka.net/excel/vba/tips/tips36.htm
（もこな２ ） 2020/06/26(金) 11:45
まだマクロ勉強中でよくわかってません
格納したやつを書きだすのとは違うってことなんでしょうか？
では、
'--- 指定フォルダ内に含まれるすべてのファイルパスを取得 ---'
'--- １次元配列の要素数を取得する関数 ---'
この後に書き出すものを作成したらいいのでしょうか？
（いちご） 2020/06/26(金) 12:42
Sub Sample()
Call FileSearch("C:\Sample")
End Sub
Sub FileSearch(Path As String)
Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Folder In FSO.GetFolder(Path).SubFolders
Call FileSearch(Folder.Path)
Next Folder
For Each File In FSO.GetFolder(Path).Files
Debug.Print File.Path
Next File
End Sub
（いちご） 2020/06/26(金) 12:56
どの部分が出力にかかわってくるかわかっているかどうかで説明が変わるので、そこが理解できているのか教えてください。
また、↓も読みましたか？
http://officetanaka.net/excel/vba/file/file07.htm
（もこな２ ） 2020/06/26(金) 13:04
ステップ実行で確認しましたが恥ずかしながら動きを見てもわからなかったです
教えてもらったサイトは両方とも読みましたし、試してもみましたが
何も起こらなかったです
両方とも書き出すよう追加しなくちゃいけないんでしょうか？
http://officetanaka.net/excel/vba/file/file07.htm
↑
このようにセルにファイル（できればフォルダも）を書き出したいです
（いちご） 2020/06/26(金) 14:47
（γ） 2020/06/28(日) 06:19
＞何も起こらなかったです
何も起こらないことはないと思いますけど・・・・該当のフォルダやファイルが無かったなんてオチはないですよね？
■１
たとえば、A1セルに「ああ」とマクロで書き込むなら↓ですよね？
Range("A1").Value = "ああ"
これを紹介した事例ではCellsプロパティを使って↓のようにしています。
Cells(1,1).Value = "ああ"
注意点として↓のように行・列の順番が違います
Rangeプロパティ･･･[列文字]と[行番号]を組み合わせて記述
Cellsプロパティ･･･[行番号]と[列番号（例外的に列文字でもOK）]をそれぞれ指定するように記述
ここまでは理解されてますか？理解してから読み進めてください。
■２
今回は、セルに出力したいのですから↓ではちょっとまずいですよね？
↓配列に格納している str(i) = f.Path
↓イミディエイトに出力している Debug.Print File.Path
なので、例えば↓のようにセルに書き込めばいいじゃないですかと言っていたわけです。
Cells(1,1).Value.Value = 書き込みたい内容
ただ、上記のように行も列固定してしまっては、毎回上書きされてしまうので実際には一定の間隔でずれていってほしいですよね。
それにはどうしたらよいか考えてみてください。
・
・
・
答えは簡単、書き込むごとに行番号に加算していけばいいんです。
なので紹介したサイトでは、書き込む直前に行番号に使っている変数「cnt」に１を足しているのです。
cnt = cnt + 1 Cells(cnt, 1) = buf
ここまでもよろしいですか？次からややこしくなりますので、分からない場合は戻って再度読んだり、聞いたりしてください。
■３
最初に提示されたコードでは再帰処理というものをしています。
〜★〜 ↓は最初に提示されたコードがなぜ再帰処理をしているかわからない場合のみ読んでください 〜★〜
再帰処理とは自分自身を呼び出す処理です。
なぜそのようなことをしているかというと、ずばり「サブフォルダ」まで対象にしたいためです。
さらにサブフォルダの配下にもサブフォルダ（元のフォルダからみると孫フォルダ、ひ孫フォルダ・・・）があるかもしれませんからサブフォルダの下にサブフォルダがある限りどんどん下がって調べているわけです。
さて、再帰処理は自分自身を呼び出すと書きました。
しかし、呼び出したものと親元は、あくまで別のプロシージャとして扱われますから、プロシージャ内で宣言した変数もそれぞれ別扱いになります。
そうなると、例えば「cnt」をプロシージャごとに宣言してしまうと、フォルダが切り替わるたびに１行目から出力するようになってしまいマいことになります。
これを回避するために、「cnt」は１つのプロシージャではなく、複数のプロシージャから使う変数として設定してあげる必要があるわけです。
http://officetanaka.net/excel/vba/variable/05.htm
■４
ということで、"配列を使わずに"１処理ずつセルに出力するならこんな感じです。
Option Explicit
Dim cnt As Long
'-------------------------------------------------
Sub メインルーチンA()
cnt = 1
Dim フォルダパス As String
フォルダパス = "C:\Test"
Call サブルーチンA(CreateObject("Scripting.FileSystemObject").GetFolder(フォルダパス))
End Sub
'--------------------------------------------------
Sub サブルーチンA(フォルダ As Object)
Dim サブフォルダ As Object
Dim ファイル As Object
Dim フラグ As Boolean
For Each サブフォルダ In フォルダ.SubFolders
Call サブルーチンA(サブフォルダ)
Next サブフォルダ
For Each ファイル In フォルダ.Files
If Not フラグ Then
Cells(cnt, "A").Value = フォルダ.Path
フラグ = True
End If
Cells(cnt, "B").Value = ファイル.Name
cnt = cnt + 1
Next
End Sub
（もこな２ ） 2020/06/28(日) 08:32
これが理解できれば、呼び出した最初のプロシージャに戻ってきたときに、配列に格納されているファイルパス？を一気に出力すればいいのはわかりますよね？
（出力する方法はγさんのコメントを参照）
Sub メインルーチンB()
Dim 配列 As Variant
Dim フォルダパス As String
フォルダパス = "C:\Test"
ReDim 配列(0)
Call サブルーチンB(CreateObject("Scripting.FileSystemObject").GetFolder(フォルダパス), 配列)
'▼ここで一気に出力
Range("A1").Resize(UBound(配列)).Value = WorksheetFunction.Transpose(配列)
End Sub
'--------------------------------------------------
Sub サブルーチンB(フォルダ As Object, 配列)
Dim サブフォルダ As Object
Dim ファイル As Object
For Each サブフォルダ In フォルダ.SubFolders
Call サブルーチンB(サブフォルダ, 配列)
Next サブフォルダ
For Each ファイル In フォルダ.Files
配列(UBound(配列)) = ファイル.Path
ReDim Preserve 配列(UBound(配列) + 1)
Next
End Sub
■６
ちなみに、サブフォルダを含めたファイル名一覧を取得したいのであれば、FSOを使わずにVBA上でコマンドプロンプトのDIRコマンドを実行しその結果を利用するといった方法もあります。
(そちらの方法の説明は苦手なので、過去ログを紹介するだけにとどめておきます。) [[20200616124543]] 『フォルダ名の取得』 [[20200206165234]] 『ブック内の値をシート名を含む他のブックを指定フォルダの中から検索して開きたい』（我論） [[20191111110431]] 『フォルダ名の全ファイル名を取得する』（りんご）
（もこな２ ） 2020/06/28(日) 09:02
それで練習をかねて■4のコードを
B列が最下層、C列、D列とひとつづつ上層階層に上がっていくように、
A列にフルパス、B列にファイル名、C列〜フォルダ名とやってみました
C列まではできたのですがD列以降の上層階層にあるフォルダ名をどうやったら取得できるかが
できれば教えてくれませんか？
フルパスを使ってMID関数とかと思ったんですが文字数の割り出しができなかったです
（いちご） 2020/06/29(月) 13:14
Option Explicit
Dim cnt As Long
'-------------------------------------------------
Sub メインルーチンA()
cnt = 5
Dim フォルダパス As String
フォルダパス = Sheets("テスト").Range("C2")
Call サブルーチンA(CreateObject("Scripting.FileSystemObject").GetFolder(フォルダパス))
End Sub
'--------------------------------------------------
Sub サブルーチンA(フォルダ As Object)
Dim サブフォルダ As Object
Dim ファイル As Object
Dim フラグ As Boolean
For Each サブフォルダ In フォルダ.SubFolders
Call サブルーチンA(サブフォルダ)
Next サブフォルダ
For Each ファイル In フォルダ.Files
If Not フラグ Then
Sheets("作業シート").Cells(cnt, "A").Value = フォルダ.Path
フラグ = True
End If
Sheets("作業シート").Cells(cnt, "B").Value = ファイル.Name
cnt = cnt + 1
Next
For Each サブフォルダ In フォルダ.SubFolders
If Not フラグ Then
Sheets("作業シート").Cells(cnt, "A").Value = サブフォルダ.Path
フラグ = True
End If
Sheets("作業シート").Cells(cnt, "C").Value = サブフォルダ.Name
'Sheets("作業シート").Cells(cnt, "D").Value = フォルダ.ParentFolder.Name
cnt = cnt + 1
Next
sfp = Len(cPath) + 1
End Sub
コードのっけるの忘れてました、ごめんなさい
（いちご） 2020/06/29(月) 13:22
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.