폴더 구조 나열 Excel VBA
Excel VBA로 만들었습니다.
제발.
사용하십시오.
편집해야 할 점은 변수 "Path"의 값뿐입니다.
14 년 만에 프로그래밍 쓰고 있기 때문에 리팩토링 해주는 사람 모집 중입니다 m (__) m
Dim numOfDelimiter As Long
Sub mainFFs()
'Declare
Dim subFolders As Object
Dim Path As String
Dim rowP As Long
Dim culP As Long
Dim numOfSubF As Long
Dim buf As String
'Set values
Path = "C:\Users\" 'ここに一番上のフォルダを指定してくださいね
rowP = 1
culP = 1
'Pathに \ が何個あるか数える
numOfDelimiter = UBound(Split(Path, "\"))
'指定したフォルダだけ、書いてしまう
Cells(1, 1) = Path
culP = culP + 1
buf = Dir(Path & "\*.*")
Do While buf <> ""
Cells(rowP, culP) = buf
rowP = rowP + 1
buf = Dir()
Loop
Call writeSubFFs(Path, culP, rowP)
End Sub
Sub writeSubFFs(Path As String, culP As Long, rowP As Long)
'階層の調整
Dim curPath As Long '文字カウント数
curPath = UBound(Split(Path, "\"))
If curPath <= numOfDelimiter + 1 Then
culP = 3
Else
culP = culP + 1
End If
'*** Process ****
'①フォルダ取得
Set subFolders = CreateObject("Scripting.FileSystemObject").GetFolder(Path).subFolders
For Each subFolders In subFolders
'②フォルダ記載
Path = subFolders.Path
Cells(rowP, culP) = Path
'③ファイル取得
culP = culP + 1
On Error Resume Next
buf = Dir(Path & "\*.*")
'④ファイル記載
Do While buf <> ""
Cells(rowP, culP) = buf
rowP = rowP + 1
buf = Dir()
Loop
culP = culP - 1
rowP = rowP + 1
Call writeSubFFs(Path, culP, rowP)
Next subFolders
End Sub
덧붙여서, writeSubFFs는 자신을 다시 시작합니다.
(아래에서 4행째의 Call로)
이유는, 재기하지 않으면 Sub 폴더 1 계층분 밖에 취득할 수 없었기 때문.
향후의 응용으로서는, 패스를 링크로 해 보거나, 2개의 HDD의 차분만을 동기하는 것 같은 파일의 전단의 처리로서 이용하거나(바퀴 재발명할 것 같은 예감), 내보내는 대상 파일에 조건을 붙여, 원하는 파일만 기재하거나 등 여러가지 할 수 있지요.
주의점:
C 드라이브에서 실행하면,
내 환경이라면 엄청난 양의 파일이 될 것 같았습니다.
(이하는, 45만 파일 검출 정도로 처리를 멈췄습니다.의 그림)
거기까지 검출하고 싶지 않은 경우는, 대상 파일을 한정하게 되어, 행의 카운터에 제한을 마련하는 것이 좋을지도 모릅니다.
참고로 한 사이트
결국 이것을 개편 한 것이 이번 코드
htps //w w. 이미 g. t / t ch / e xv to / 0060088. HTML
이것을 그대로 구현하고 싶었지만 bas 파일이 귀찮았습니다.
htps //w w. 아사히네 t. 오 r. jp / ~ e f2 오이 누에 / v 바 _ 오 / 스 b05_110_080. HTML
htps //w w. 아사히네 t. 오 r. jp / ~ e f2 오이 누에 / 드 w ㄉ 아 d / 스 b09_020_110. HTML
SES라면 권한 관계에 빠지지 않는 폴더가 있으므로 on error resume next로 날린다.
ㅜㅜㅜㅜㅜㅜㅜぃ네트 / x x l / v 바 / 치 ps / 치 ps104. htm
미래의 응용
ㅜㅜㅜㅜㅜㅜㅜぃ네 t / 에 x 세 l / v 바 / 치 ps / 치 ps95. htm
htp : // bg. j 미리. 네 t/? p=1763
Reference
이 문제에 관하여(폴더 구조 나열 Excel VBA), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다
https://qiita.com/KenichiTakai/items/1b386a2f50b20b50bce9
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념
(Collection and Share based on the CC Protocol.)
Dim numOfDelimiter As Long
Sub mainFFs()
'Declare
Dim subFolders As Object
Dim Path As String
Dim rowP As Long
Dim culP As Long
Dim numOfSubF As Long
Dim buf As String
'Set values
Path = "C:\Users\" 'ここに一番上のフォルダを指定してくださいね
rowP = 1
culP = 1
'Pathに \ が何個あるか数える
numOfDelimiter = UBound(Split(Path, "\"))
'指定したフォルダだけ、書いてしまう
Cells(1, 1) = Path
culP = culP + 1
buf = Dir(Path & "\*.*")
Do While buf <> ""
Cells(rowP, culP) = buf
rowP = rowP + 1
buf = Dir()
Loop
Call writeSubFFs(Path, culP, rowP)
End Sub
Sub writeSubFFs(Path As String, culP As Long, rowP As Long)
'階層の調整
Dim curPath As Long '文字カウント数
curPath = UBound(Split(Path, "\"))
If curPath <= numOfDelimiter + 1 Then
culP = 3
Else
culP = culP + 1
End If
'*** Process ****
'①フォルダ取得
Set subFolders = CreateObject("Scripting.FileSystemObject").GetFolder(Path).subFolders
For Each subFolders In subFolders
'②フォルダ記載
Path = subFolders.Path
Cells(rowP, culP) = Path
'③ファイル取得
culP = culP + 1
On Error Resume Next
buf = Dir(Path & "\*.*")
'④ファイル記載
Do While buf <> ""
Cells(rowP, culP) = buf
rowP = rowP + 1
buf = Dir()
Loop
culP = culP - 1
rowP = rowP + 1
Call writeSubFFs(Path, culP, rowP)
Next subFolders
End Sub
결국 이것을 개편 한 것이 이번 코드
htps //w w. 이미 g. t / t ch / e xv to / 0060088. HTML
이것을 그대로 구현하고 싶었지만 bas 파일이 귀찮았습니다.
htps //w w. 아사히네 t. 오 r. jp / ~ e f2 오이 누에 / v 바 _ 오 / 스 b05_110_080. HTML
htps //w w. 아사히네 t. 오 r. jp / ~ e f2 오이 누에 / 드 w ㄉ 아 d / 스 b09_020_110. HTML
SES라면 권한 관계에 빠지지 않는 폴더가 있으므로 on error resume next로 날린다.
ㅜㅜㅜㅜㅜㅜㅜぃ네트 / x x l / v 바 / 치 ps / 치 ps104. htm
미래의 응용
ㅜㅜㅜㅜㅜㅜㅜぃ네 t / 에 x 세 l / v 바 / 치 ps / 치 ps95. htm
htp : // bg. j 미리. 네 t/? p=1763
Reference
이 문제에 관하여(폴더 구조 나열 Excel VBA), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다 https://qiita.com/KenichiTakai/items/1b386a2f50b20b50bce9텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념 (Collection and Share based on the CC Protocol.)