teratail header banner
teratail header banner
質問するログイン新規登録

質問編集履歴

1

コードに追記

2020/10/10 03:52

投稿

KANNORYUJI
KANNORYUJI

スコア7

title CHANGED
File without changes
body CHANGED
@@ -1,4 +1,66 @@
1
+ ```ここに言語を入力
2
+ Sub FolderScript()
3
+
4
+ Dim strPath As String, i As Long
5
+
6
+ strPath = Range("B2").Value
7
+
8
+ Range("B3").Select
9
+ i = 3
10
+ Fileshow strPath, i
11
+
12
+ End Sub
13
+
14
+ Public Sub Fileshow(strPath, i)
15
+ Dim objFso As Object, objFolder As Object, objFile As Object
16
+ Dim objSub As Object, ws As Worksheet
17
+ Dim strList() As String
18
+
19
+ Dim rr As Range
20
+ Dim bb
21
+ Dim y As Integer
22
+ Dim col As Integer
23
+
24
+ Dim oFile As Object
25
+
26
+ Set ws = ThisWorkbook.Worksheets("FileList")
27
+ Set objFso = CreateObject("scripting.Filesystemobject")
28
+ Set objFolder = objFso.GetFolder(strPath)
29
+
30
+ Application.ScreenUpdating = False
31
+
32
+ For Each objFile In objFolder.Files
33
+ ws.Cells(i, 2) = objFso.GetBaseName(objFile.Path)
34
+ ws.Cells(i, 2).Select
35
+ ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=objFile.Path, TextToDisplay:=objFile.Name
36
+
37
+ ws.Cells(i, 3) = objFile.Type
38
+ ws.Cells(i, 4) = Int(objFile.Size / 1024)
39
+ ws.Cells(i, 5) = objFile.DateCreated
40
+ ws.Cells(i, 6) = objFile.DatelastAccessed
41
+ ws.Cells(i, 7) = objFile.DateLastModified
42
+ ws.Cells(i, 8) = objFile.ParentFolder.Path
43
+
44
+ For Each rr In ws.Cells(i, 8).Rows
45
+ bb = Split(rr, "\")
46
+ col = 9
47
+ For y = 1 To UBound(bb)
48
+ Cells(rr.Row, col) = bb(y)
49
+ col = col + 1
50
+ Next y
51
+
52
+ i = i + 1
53
+ Next rr
54
+
55
+ Next
56
+
57
+ For Each objSub In objFolder.SubFolders
58
+ Fileshow objSub.Path, i
59
+ Next
60
+
61
+ End Sub
62
+ コード
1
- Excel VBAを使ってファイルリスト作成をおこなっています。
63
+ ```Excel VBAを使ってファイルリスト作成をおこなっています。
2
64
  現在の課題は、5万ファイルに及ぶ大規模なリスト作成のためにこのマクロコードを使うと
3
65
  リスト作成の完了までおよそ4時間くらいかかってしまうため、この所要時間を2時間くらいまで短縮化したいと思っています。
4
66