回答編集履歴

2

処理を変更しました

2017/09/19 11:55

投稿

baseballyama
baseballyama

スコア316

test CHANGED
@@ -8,24 +8,92 @@
8
8
 
9
9
  ```VBS
10
10
 
11
+ ' CSVのマージ実施
12
+
13
+ Call MergeCsv
14
+
11
15
 
12
16
 
13
- ' CSVのマージ実施
14
-
15
- Call MergeCsv
17
+ Sub MergeCsv()
16
18
 
17
19
 
18
20
 
21
+ ' 変数宣言
22
+
23
+ Dim fso
24
+
25
+ Dim path
26
+
27
+
28
+
29
+ ' オブジェクト初期化
30
+
31
+ Set fso = CreateObject("Scripting.FileSystemObject")
32
+
33
+
34
+
35
+ ' 処理対象フォルダパス取得
36
+
37
+ path = InputBox("処理対象フォルダパスを入力して下さい", "情報入力")
38
+
39
+
40
+
41
+ ' 入力されなかった場合は処理終了
42
+
43
+ If path = "" Then
44
+
45
+ MsgBox "処理対象フォルダパスが入力されませんでした。", vbCritical + vbOKOnly, "エラー"
46
+
47
+ Exit Sub
48
+
49
+ End If
50
+
51
+
52
+
53
+ ' 入力されたフォルダが存在しない場合は処理終了
54
+
55
+ If Not fso.FolderExists(path) Then
56
+
57
+ MsgBox "処理対象フォルダパスは存在しません。", vbCritical + vbOKOnly, "エラー"
58
+
59
+ Exit Sub
60
+
61
+ End If
62
+
63
+
64
+
65
+ Call MergeCsvSub(path, "AAA")
66
+
67
+ Call MergeCsvSub(path, "CCC")
68
+
69
+
70
+
71
+ ' オブジェクト開放
72
+
73
+ Set fso = Nothing
74
+
75
+
76
+
77
+ ' 結果出力
78
+
79
+ MsgBox "処理が終了しました。" & vbLf & "処理対象フォルダ内のファイルを確認して下さい", vbInformation + vbOKOnly, "処理完了"
80
+
81
+
82
+
83
+ End Sub
84
+
85
+
86
+
87
+
88
+
19
- Sub MergeCsv()
89
+ Sub MergeCsvSub(path, pReg)
20
-
21
-
90
+
91
+
22
92
 
23
93
  ' 変数宣言
24
94
 
25
95
  Dim re, fso, file, textStream
26
96
 
27
- Dim path
28
-
29
97
  Dim lineNum
30
98
 
31
99
  Dim mergedText
@@ -40,37 +108,7 @@
40
108
 
41
109
  Set fso = CreateObject("Scripting.FileSystemObject")
42
110
 
43
-
44
-
45
- ' 処理対象フォルダパス取得
111
+
46
-
47
- path = InputBox("処理対象フォルダパスを入力して下さい", "情報入力")
48
-
49
-
50
-
51
- ' 入力されなかった場合は処理終了
52
-
53
- If path = "" Then
54
-
55
- MsgBox "処理対象フォルダパスが入力されませんでした。", vbCritical + vbOKOnly, "エラー"
56
-
57
- Exit Sub
58
-
59
- End If
60
-
61
-
62
-
63
- ' 入力されたフォルダが存在しない場合は処理終了
64
-
65
- If Not fso.FolderExists(path) Then
66
-
67
- MsgBox "処理対象フォルダパスは存在しません。", vbCritical + vbOKOnly, "エラー"
68
-
69
- Exit Sub
70
-
71
- End If
72
-
73
-
74
112
 
75
113
  ' 検索条件の設定
76
114
 
@@ -80,7 +118,7 @@
80
118
 
81
119
  .IgnoreCase = True
82
120
 
83
- .Pattern = "^(AAA|ccc).*\.csv$"
121
+ .Pattern = "^" & pReg & ".*\.csv$"
84
122
 
85
123
  End With
86
124
 
@@ -154,6 +192,10 @@
154
192
 
155
193
 
156
194
 
195
+ WScript.Echo file.Name & "を処理しました"
196
+
197
+
198
+
157
199
  End With
158
200
 
159
201
 
@@ -168,23 +210,23 @@
168
210
 
169
211
  ' 時刻取得
170
212
 
171
- time= Year(Now())
213
+ time = Year(Now())
172
-
214
+
173
- time= time & Right("0" & Month(Now()) , 2)
215
+ time = time & Right("0" & Month(Now()), 2)
174
-
216
+
175
- time= time & Right("0" & Day(Now()) , 2)
217
+ time = time & Right("0" & Day(Now()), 2)
176
-
218
+
177
- time= time & Right("0" & Hour(Now()) , 2)
219
+ time = time & Right("0" & Hour(Now()), 2)
178
-
220
+
179
- time= time & Right("0" & Minute(Now()) , 2)
221
+ time = time & Right("0" & Minute(Now()), 2)
180
-
222
+
181
- time= time & Right("0" & Second(Now()) , 2)
223
+ time = time & Right("0" & Second(Now()), 2)
182
224
 
183
225
 
184
226
 
185
227
  ' 結果出力
186
228
 
187
- With fso.OpenTextFile(path & "\result_" & time & ".csv", 2, True, -2)
229
+ With fso.OpenTextFile(path & "\" & pReg & "result_" & time & ".csv", 2, True, -2)
188
230
 
189
231
  .Write mergedText
190
232
 
@@ -192,7 +234,7 @@
192
234
 
193
235
  End With
194
236
 
195
-
237
+
196
238
 
197
239
  ' オブジェクト開放
198
240
 
@@ -204,18 +246,8 @@
204
246
 
205
247
  Set textStream = Nothing
206
248
 
207
-
208
-
209
- ' 処理完了メッセージ出力
249
+
210
-
211
- MsgBox "処理が終了しました。" & vbLf & "処理対象フォルダ内の" & "result_" & time & ".csv" & "を確認して下さい", vbInformation + vbOKOnly, "処理完了"
212
-
213
-
214
250
 
215
251
  End Sub
216
252
 
217
-
218
-
219
-
220
-
221
253
  ```

1

プログラムのコメントに抜けがありましたので追加しました

2017/09/19 11:55

投稿

baseballyama
baseballyama

スコア316

test CHANGED
@@ -206,6 +206,8 @@
206
206
 
207
207
 
208
208
 
209
+ ' 処理完了メッセージ出力
210
+
209
211
  MsgBox "処理が終了しました。" & vbLf & "処理対象フォルダ内の" & "result_" & time & ".csv" & "を確認して下さい", vbInformation + vbOKOnly, "処理完了"
210
212
 
211
213