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

質問編集履歴

2

ソースを修正しました。

2021/01/05 07:32

投稿

rena_168
rena_168

スコア73

title CHANGED
File without changes
body CHANGED
@@ -5,13 +5,17 @@
5
5
  先輩たちのご指導を宜しくお願いします。
6
6
  ```VBA
7
7
  Sub GetFileCount()
8
- 'Dim col As Collection
8
+ Dim col, gol_col As Collection
9
+ Set col = New Collection
9
- 'Set col = New Collection
10
+ 'Set gol_col = New Collection
10
11
  Dim savePath As String
11
12
  savePath = Range("B2").Value
12
13
 
13
14
  Dim dicList As Object
14
15
  Set dicList = CreateObject("Scripting.Dictionary")
16
+ Dim gl_dicList As Object
17
+ Set gl_dicList = CreateObject("Scripting.Dictionary")
18
+ Dim gl_cnt As Integer
15
19
 
16
20
  Dim MAXSize, MAX2GSize As Currency
17
21
  MAXSize = 2147483648# 'ファイルサイズ2G最大値
@@ -27,13 +31,13 @@
27
31
 
28
32
  Dim fl As Folder
29
33
  Set fl = FSO.GetFolder(folderPath) ' フォルダを取得
30
- Dim s, str As String
34
+ Dim s, addfiname As String
31
35
  Dim f As file
32
36
  Dim a As Long
33
37
  Dim bSize As Currency
34
38
  Dim count As Integer
35
39
  Dim a_sFolder As String
36
- a_sFolder = "100個のファイルパス" & "\" & Format(Date, "yyyymmdd")
40
+ a_sFolder = "ファイルパス" & "\" & Format(Date, "yyyymmdd")
37
41
 
38
42
  For Each f In fl.files ' フォルダ内のファイルを取得
39
43
  s = f.Path ' パスを取得
@@ -46,23 +50,47 @@
46
50
  bSize = CCur(bSize) + CCur(iSize)
47
51
  If (CCur(bSize) <= MAXSize) Then
48
52
 
49
- If Dir(a_sFolder, vbDirectory) = "" Then
53
+ 'If Dir(a_sFolder, vbDirectory) = "" Then
50
- MkDir a_sFolder
54
+ 'MkDir a_sFolder
51
- End If
55
+ 'End If
52
- Call FSO.MoveFile(s, a_sFolder & "\")
56
+ 'Call FSO.MoveFile(s, a_sFolder & "\")
57
+ count = count + 1
53
- 'str = str & FSO.GetFile(s).Name & " "
58
+ addfiname = addfiname & FSO.GetFile(s).Name & " "
54
- 'str = str & s & " "
59
+ addfiname = addfiname & s & " "
55
60
  'col.Add s
61
+ dicList.Add "key" & CStr(count), s
62
+ Debug.Print (dicList.Item("key" & CStr(count)))
56
63
  Else
64
+ gl_dicList.Add CStr(gl_cnt), dicList
57
- bSize = bSize - iSize '足して2G超えたので、足した分を引く
65
+ MsgBox gl_dicList(CStr(gl_cnt))("key1")
66
+ 'Debug.Print CStr(gl_cnt)
67
+ 'Debug.Print gl_dicList(CStr(gl_cnt))
68
+ gl_cnt = gl_cnt + 1
69
+ dicList.RemoveAll
58
- '圧縮処理
70
+ 'col = New Collection
59
71
  count = count + 1
72
+ bSize = 0
73
+ bSize = CCur(bSize) + CCur(iSize)
74
+ If (CCur(bSize) <= MAXSize) Then
75
+
76
+ 'If Dir(a_sFolder, vbDirectory) = "" Then
77
+ 'MkDir a_sFolder
78
+ 'End If
79
+ 'Call FSO.MoveFile(s, a_sFolder & "\")
80
+ addfiname = addfiname & FSO.GetFile(s).Name & " "
60
- a_sFolder = a_sFolder & "_" & count
81
+ addfiname = addfiname & s & " "
82
+ 'col.Add s
83
+ dicList.Add "key" & CStr(count), s
84
+ Debug.Print (dicList.Item("key" & CStr(count)))
85
+ End If
61
86
 
87
+ '圧縮処理
88
+ 'a_sFolder = a_sFolder & "_" & count
89
+
62
90
  'savePath = savePath & "\" & count & ".zip"
63
91
  'Debug.Print (savePath)
64
92
  'CompressArchive_cmd a_sFolder, savePath, count
65
- 'Call FSO.MoveFile(a_sFolder & "*", "移動先パス")
93
+ 'Call FSO.MoveFile(a_sFolder & "*", "移動先パス")
66
94
  'CompressArchive col, savePath
67
95
  'FileArchive str
68
96
  'End

1

ソースを補充しました。

2021/01/05 07:32

投稿

rena_168
rena_168

スコア73

title CHANGED
File without changes
body CHANGED
@@ -4,7 +4,38 @@
4
4
 
5
5
  先輩たちのご指導を宜しくお願いします。
6
6
  ```VBA
7
+ Sub GetFileCount()
8
+ 'Dim col As Collection
9
+ 'Set col = New Collection
10
+ Dim savePath As String
11
+ savePath = Range("B2").Value
12
+
13
+ Dim dicList As Object
14
+ Set dicList = CreateObject("Scripting.Dictionary")
15
+
16
+ Dim MAXSize, MAX2GSize As Currency
17
+ MAXSize = 2147483648# 'ファイルサイズ2G最大値
18
+ 'Debug.Print (MAXSize)
19
+
20
+ 'ファイル数を知りたいフォルダのパス
21
+ Dim folderPath As String
22
+ folderPath = Range("B1").Value
23
+
24
+ 'ファイルシステムオブジェクト
25
+ Dim FSO As Object
26
+ Set FSO = CreateObject("Scripting.FileSystemObject")
27
+
28
+ Dim fl As Folder
29
+ Set fl = FSO.GetFolder(folderPath) ' フォルダを取得
30
+ Dim s, str As String
31
+ Dim f As file
32
+ Dim a As Long
33
+ Dim bSize As Currency
34
+ Dim count As Integer
35
+ Dim a_sFolder As String
36
+ a_sFolder = "100個のファイルパス" & "\" & Format(Date, "yyyymmdd")
37
+
7
- For Each f In fl.files ' フォルダ内のファイルを取得
38
+ For Each f In fl.files ' フォルダ内のファイルを取得
8
39
  s = f.Path ' パスを取得
9
40
  'Debug.Print (s) ' D:\TipsFolder\Tips.txt など
10
41
  Dim iSize
@@ -23,9 +54,59 @@
23
54
  'str = str & s & " "
24
55
  'col.Add s
25
56
  Else
26
- bSize = bSize - iSize
57
+ bSize = bSize - iSize '足して2G超えたので、足した分を引く
58
+ '圧縮処理
27
59
  count = count + 1
28
60
  a_sFolder = a_sFolder & "_" & count
29
61
 
62
+ 'savePath = savePath & "\" & count & ".zip"
63
+ 'Debug.Print (savePath)
64
+ 'CompressArchive_cmd a_sFolder, savePath, count
65
+ 'Call FSO.MoveFile(a_sFolder & "*", "移動先のパス")
66
+ 'CompressArchive col, savePath
67
+ 'FileArchive str
68
+ 'End
30
69
  End If
70
+ 'Debug.Print (str)
71
+ 'Debug.Print (bSize)
72
+
73
+ 'dicList.Add s, iSize
74
+ 'bSize = bSize + iSize
75
+ 'Debug.Print "---bSize = " & bSize
76
+ 'If (CLng(bSize) <= MAXSize) Then
77
+ 'count = count + 1
78
+ 'End If
79
+ Next
80
+
81
+ 'ループ用の変数
82
+ 'Dim i, j As Integer
83
+ 'Dim keys
84
+ 'Dim items
85
+
86
+ 'keys = dicList.keys
87
+ 'items = dicList.items
88
+ 'j = 0
89
+ 'For i = 0 To dicList.count - 1
90
+ 'bSize = bSize + items(i)
91
+ 'If (CLng(bSize) <= MAXSize) Then
92
+
93
+ 'Else
94
+ 'bSize = bSize - items(i)
95
+ 'j = i - 1
96
+ 'End If
97
+ 'Debug.Print "ファイル名:" & keys(i) & "、ファイルサイズ:" & items(i)
98
+ 'Next i
99
+
100
+ ' 後始末
101
+ Set FSO = Nothing
102
+
103
+ 'ファイル数を格納する変数
104
+ 'Dim j As Long
105
+ 'j = fso.GetFolder(folderPath).files.count
106
+ 'Debug.Print "ファイルCount = " & j
107
+ End Sub
31
- ```
108
+ ```
109
+ 100個ファイルのファイル名は関係なく、サイズのみ取得して、合計サイズが2Gだったら「yyyyddmm」フォルダ(任意)に移動し、次のファイルからまた合計が2Gだったら「yyyyddmm_1」フォルダ(任意)に移動していって、全ファイルを2Gサイズのまとまりをフォルダ分けして移動したいです。
110
+ フォルダ分けでなくても、2次元配列の1行目に2G単位の全ファイル名(例えば1個目~9個目ファイルが2G)が格納され、2行目にも(10個目~18個目ファイルが2G)ファイル名が格納されてもいいです。
111
+
112
+ 宜しくお願いします。