これでちゃんと動きます。
エラーハンドリングなどを手厚く実施したために少し長くなっています。
これで一度試してみて下さい。
VBS
1 ' CSVのマージ実施
2 Call MergeCsv
3
4Sub MergeCsv()
5
6 ' 変数宣言
7 Dim fso
8 Dim path
9
10 ' オブジェクト初期化
11 Set fso = CreateObject("Scripting.FileSystemObject")
12
13 ' 処理対象フォルダパス取得
14 path = InputBox("処理対象フォルダパスを入力して下さい", "情報入力")
15
16 ' 入力されなかった場合は処理終了
17 If path = "" Then
18 MsgBox "処理対象フォルダパスが入力されませんでした。", vbCritical + vbOKOnly, "エラー"
19 Exit Sub
20 End If
21
22 ' 入力されたフォルダが存在しない場合は処理終了
23 If Not fso.FolderExists(path) Then
24 MsgBox "処理対象フォルダパスは存在しません。", vbCritical + vbOKOnly, "エラー"
25 Exit Sub
26 End If
27
28 Call MergeCsvSub(path, "AAA")
29 Call MergeCsvSub(path, "CCC")
30
31 ' オブジェクト開放
32 Set fso = Nothing
33
34 ' 結果出力
35 MsgBox "処理が終了しました。" & vbLf & "処理対象フォルダ内のファイルを確認して下さい", vbInformation + vbOKOnly, "処理完了"
36
37End Sub
38
39
40Sub MergeCsvSub(path, pReg)
41
42 ' 変数宣言
43 Dim re, fso, file, textStream
44 Dim lineNum
45 Dim mergedText
46 Dim time
47
48 ' オブジェクト初期化
49 Set re = CreateObject("VBScript.RegExp")
50 Set fso = CreateObject("Scripting.FileSystemObject")
51
52 ' 検索条件の設定
53 With re
54 .Global = True
55 .IgnoreCase = True
56 .Pattern = "^" & pReg & ".*\.csv$"
57 End With
58
59 ' 結合結果初期化
60 mergedText = ""
61
62 ' 全ファイル走査
63 For Each file In fso.GetFolder(path).Files
64
65 ' 条件に合致するファイルのみ処理
66 If re.Test(file.Name) Then
67
68 ' テキスト取得
69 Set textStream = fso.OpenTextFile(file.path)
70
71 ' 行数初期化
72 lineNum = 1
73
74 ' 全行走査
75 With textStream
76 Do Until .AtEndOfStream
77
78 ' 結合後テキストを生成
79 If mergedText <> "" Then
80 mergedText = mergedText & vbLf & file.Name & "," & lineNum & "," & .ReadLine()
81 Else
82 mergedText = mergedText & file.Name & "," & lineNum & "," & .ReadLine()
83 End If
84
85 ' カウンタアップ
86 lineNum = lineNum + 1
87
88 Loop
89
90 ' テキストを閉じる
91 .Close
92
93 WScript.Echo file.Name & "を処理しました"
94
95 End With
96
97 End If
98
99 Next
100
101 ' 時刻取得
102 time = Year(Now())
103 time = time & Right("0" & Month(Now()), 2)
104 time = time & Right("0" & Day(Now()), 2)
105 time = time & Right("0" & Hour(Now()), 2)
106 time = time & Right("0" & Minute(Now()), 2)
107 time = time & Right("0" & Second(Now()), 2)
108
109 ' 結果出力
110 With fso.OpenTextFile(path & "\" & pReg & "result_" & time & ".csv", 2, True, -2)
111 .Write mergedText
112 .Close
113 End With
114
115 ' オブジェクト開放
116 Set re = Nothing
117 Set fso = Nothing
118 Set file = Nothing
119 Set textStream = Nothing
120
121End Sub
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/09/19 11:18
2017/09/19 12:23 編集
2017/09/20 01:08
2017/09/20 01:27
2017/09/22 00:20
2017/09/22 01:09
2017/09/22 03:00