質問編集履歴

2

ソースを修正しました。

2021/01/05 07:32

投稿

rena_168
rena_168

スコア72

test CHANGED
File without changes
test CHANGED
@@ -12,9 +12,11 @@
12
12
 
13
13
  Sub GetFileCount()
14
14
 
15
- 'Dim col As Collection
15
+ Dim col, gol_col As Collection
16
+
16
-
17
+ Set col = New Collection
18
+
17
- 'Set col = New Collection
19
+ 'Set gol_col = New Collection
18
20
 
19
21
  Dim savePath As String
20
22
 
@@ -26,6 +28,12 @@
26
28
 
27
29
  Set dicList = CreateObject("Scripting.Dictionary")
28
30
 
31
+ Dim gl_dicList As Object
32
+
33
+ Set gl_dicList = CreateObject("Scripting.Dictionary")
34
+
35
+ Dim gl_cnt As Integer
36
+
29
37
 
30
38
 
31
39
  Dim MAXSize, MAX2GSize As Currency
@@ -56,7 +64,7 @@
56
64
 
57
65
  Set fl = FSO.GetFolder(folderPath) ' フォルダを取得
58
66
 
59
- Dim s, str As String
67
+ Dim s, addfiname As String
60
68
 
61
69
  Dim f As file
62
70
 
@@ -68,7 +76,7 @@
68
76
 
69
77
  Dim a_sFolder As String
70
78
 
71
- a_sFolder = "100個のファイルパス" & "\" & Format(Date, "yyyymmdd")
79
+ a_sFolder = "ファイルパス" & "\" & Format(Date, "yyyymmdd")
72
80
 
73
81
 
74
82
 
@@ -94,29 +102,77 @@
94
102
 
95
103
 
96
104
 
97
- If Dir(a_sFolder, vbDirectory) = "" Then
105
+ 'If Dir(a_sFolder, vbDirectory) = "" Then
98
-
106
+
99
- MkDir a_sFolder
107
+ 'MkDir a_sFolder
108
+
109
+ 'End If
110
+
111
+ 'Call FSO.MoveFile(s, a_sFolder & "\")
112
+
113
+ count = count + 1
114
+
115
+ addfiname = addfiname & FSO.GetFile(s).Name & " "
116
+
117
+ addfiname = addfiname & s & " "
118
+
119
+ 'col.Add s
120
+
121
+ dicList.Add "key" & CStr(count), s
122
+
123
+ Debug.Print (dicList.Item("key" & CStr(count)))
124
+
125
+ Else
126
+
127
+ gl_dicList.Add CStr(gl_cnt), dicList
128
+
129
+ MsgBox gl_dicList(CStr(gl_cnt))("key1")
130
+
131
+ 'Debug.Print CStr(gl_cnt)
132
+
133
+ 'Debug.Print gl_dicList(CStr(gl_cnt))
134
+
135
+ gl_cnt = gl_cnt + 1
136
+
137
+ dicList.RemoveAll
138
+
139
+ 'col = New Collection
140
+
141
+ count = count + 1
142
+
143
+ bSize = 0
144
+
145
+ bSize = CCur(bSize) + CCur(iSize)
146
+
147
+ If (CCur(bSize) <= MAXSize) Then
148
+
149
+
150
+
151
+ 'If Dir(a_sFolder, vbDirectory) = "" Then
152
+
153
+ 'MkDir a_sFolder
154
+
155
+ 'End If
156
+
157
+ 'Call FSO.MoveFile(s, a_sFolder & "\")
158
+
159
+ addfiname = addfiname & FSO.GetFile(s).Name & " "
160
+
161
+ addfiname = addfiname & s & " "
162
+
163
+ 'col.Add s
164
+
165
+ dicList.Add "key" & CStr(count), s
166
+
167
+ Debug.Print (dicList.Item("key" & CStr(count)))
100
168
 
101
169
  End If
102
170
 
103
- Call FSO.MoveFile(s, a_sFolder & "\")
171
+
104
-
105
- 'str = str & FSO.GetFile(s).Name & " "
106
-
107
- 'str = str & s & " "
108
-
109
- 'col.Add s
110
-
111
- Else
112
-
113
- bSize = bSize - iSize '足して2G超えたので、足した分を引く
114
172
 
115
173
  '圧縮処理
116
174
 
117
- count = count + 1
118
-
119
- a_sFolder = a_sFolder & "_" & count
175
+ 'a_sFolder = a_sFolder & "_" & count
120
176
 
121
177
 
122
178
 
@@ -126,7 +182,7 @@
126
182
 
127
183
  'CompressArchive_cmd a_sFolder, savePath, count
128
184
 
129
- 'Call FSO.MoveFile(a_sFolder & "*", "移動先パス")
185
+ 'Call FSO.MoveFile(a_sFolder & "*", "移動先パス")
130
186
 
131
187
  'CompressArchive col, savePath
132
188
 

1

ソースを補充しました。

2021/01/05 07:32

投稿

rena_168
rena_168

スコア72

test CHANGED
File without changes
test CHANGED
@@ -10,7 +10,69 @@
10
10
 
11
11
  ```VBA
12
12
 
13
+ Sub GetFileCount()
14
+
15
+ 'Dim col As Collection
16
+
17
+ 'Set col = New Collection
18
+
19
+ Dim savePath As String
20
+
21
+ savePath = Range("B2").Value
22
+
23
+
24
+
25
+ Dim dicList As Object
26
+
27
+ Set dicList = CreateObject("Scripting.Dictionary")
28
+
29
+
30
+
31
+ Dim MAXSize, MAX2GSize As Currency
32
+
33
+ MAXSize = 2147483648# 'ファイルサイズ2G最大値
34
+
35
+ 'Debug.Print (MAXSize)
36
+
37
+
38
+
39
+ 'ファイル数を知りたいフォルダのパス
40
+
41
+ Dim folderPath As String
42
+
43
+ folderPath = Range("B1").Value
44
+
45
+
46
+
47
+ 'ファイルシステムオブジェクト
48
+
49
+ Dim FSO As Object
50
+
51
+ Set FSO = CreateObject("Scripting.FileSystemObject")
52
+
53
+
54
+
55
+ Dim fl As Folder
56
+
57
+ Set fl = FSO.GetFolder(folderPath) ' フォルダを取得
58
+
59
+ Dim s, str As String
60
+
61
+ Dim f As file
62
+
63
+ Dim a As Long
64
+
65
+ Dim bSize As Currency
66
+
67
+ Dim count As Integer
68
+
69
+ Dim a_sFolder As String
70
+
71
+ a_sFolder = "100個のファイルパス" & "\" & Format(Date, "yyyymmdd")
72
+
73
+
74
+
13
- For Each f In fl.files ' フォルダ内のファイルを取得
75
+ For Each f In fl.files ' フォルダ内のファイルを取得
14
76
 
15
77
  s = f.Path ' パスを取得
16
78
 
@@ -48,7 +110,9 @@
48
110
 
49
111
  Else
50
112
 
51
- bSize = bSize - iSize
113
+ bSize = bSize - iSize '足して2G超えたので、足した分を引く
114
+
115
+ '圧縮処理
52
116
 
53
117
  count = count + 1
54
118
 
@@ -56,6 +120,104 @@
56
120
 
57
121
 
58
122
 
123
+ 'savePath = savePath & "\" & count & ".zip"
124
+
125
+ 'Debug.Print (savePath)
126
+
127
+ 'CompressArchive_cmd a_sFolder, savePath, count
128
+
129
+ 'Call FSO.MoveFile(a_sFolder & "*", "移動先のパス")
130
+
131
+ 'CompressArchive col, savePath
132
+
133
+ 'FileArchive str
134
+
135
+ 'End
136
+
59
137
  End If
60
138
 
139
+ 'Debug.Print (str)
140
+
141
+ 'Debug.Print (bSize)
142
+
143
+
144
+
145
+ 'dicList.Add s, iSize
146
+
147
+ 'bSize = bSize + iSize
148
+
149
+ 'Debug.Print "---bSize = " & bSize
150
+
151
+ 'If (CLng(bSize) <= MAXSize) Then
152
+
153
+ 'count = count + 1
154
+
155
+ 'End If
156
+
157
+ Next
158
+
159
+
160
+
161
+ 'ループ用の変数
162
+
163
+ 'Dim i, j As Integer
164
+
165
+ 'Dim keys
166
+
167
+ 'Dim items
168
+
169
+
170
+
171
+ 'keys = dicList.keys
172
+
173
+ 'items = dicList.items
174
+
175
+ 'j = 0
176
+
177
+ 'For i = 0 To dicList.count - 1
178
+
179
+ 'bSize = bSize + items(i)
180
+
181
+ 'If (CLng(bSize) <= MAXSize) Then
182
+
183
+
184
+
185
+ 'Else
186
+
187
+ 'bSize = bSize - items(i)
188
+
189
+ 'j = i - 1
190
+
191
+ 'End If
192
+
193
+ 'Debug.Print "ファイル名:" & keys(i) & "、ファイルサイズ:" & items(i)
194
+
195
+ 'Next i
196
+
197
+
198
+
199
+ ' 後始末
200
+
201
+ Set FSO = Nothing
202
+
203
+
204
+
205
+ 'ファイル数を格納する変数
206
+
207
+ 'Dim j As Long
208
+
209
+ 'j = fso.GetFolder(folderPath).files.count
210
+
211
+ 'Debug.Print "ファイルCount = " & j
212
+
213
+ End Sub
214
+
61
215
  ```
216
+
217
+ 100個ファイルのファイル名は関係なく、サイズのみ取得して、合計サイズが2Gだったら「yyyyddmm」フォルダ(任意)に移動し、次のファイルからまた合計が2Gだったら「yyyyddmm_1」フォルダ(任意)に移動していって、全ファイルを2Gサイズのまとまりをフォルダ分けして移動したいです。
218
+
219
+ フォルダ分けでなくても、2次元配列の1行目に2G単位の全ファイル名(例えば1個目~9個目ファイルが2G)が格納され、2行目にも(10個目~18個目ファイルが2G)ファイル名が格納されてもいいです。
220
+
221
+
222
+
223
+ 宜しくお願いします。