VBS:CSVファイルを振り分ける
Option Explicit
Dim filePath
Dim folderPath
Dim objFSO
Dim ary1()
Dim ary2
Dim ary3
Dim ary4
Dim aryBuf
Dim strHeader
Dim strBuf
Set objFSO = CreateObject("Scripting.FileSystemObject")
folderPath = "C:\Users\hoge\Documents\Programing\VBS\"
filePath = "C:\Users\hoge\Documents\Programing\VBS\test.csv"
With objFSO.GetFile(filePath).OpenAsTextStream
strHeader = .ReadLine
Redim ary1(0)
Redim ary2(0)
Redim ary3(0)
Redim ary4(0)
Do Until .AtEndofStream
strBuf = .ReadLine
aryBuf = Split(strBuf,",")
Select Case aryBuf(0)
Case 1
ary1(Ubound(ary1)) = strBuf
Redim Preserve ary1(Ubound(ary1)+1)
Case 2
ary2(Ubound(ary2)) = strBuf
Redim Preserve ary2(Ubound(ary2)+1)
Case 3
ary3(Ubound(ary3)) = strBuf
Redim Preserve ary3(Ubound(ary3)+1)
Case 4
ary4(Ubound(ary4)) = strBuf
Redim Preserve ary4(Ubound(ary4)+1)
End Select
Loop
end With
Set objFSO = Nothing
Call outputCSV(folderPath & "1.csv",strHeader,ary1)
Call outputCSV(folderPath & "2.csv",strHeader,ary2)
Call outputCSV(folderPath & "3.csv",strHeader,ary3)
Call outputCSV(folderPath & "4.csv",strHeader,ary4)
Sub outputCSV(argPath,argHeader,argAry)
Dim i
Dim objFSO
Dim objText
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objText = objFSO.OpenTextFile(argPath , 8 , True)
With objText
.WriteLine argHeader
For i = 0 to Ubound(argAry) - 1
.WriteLine argAry(i)
Next
.Close
End With
set objFSO = Nothing
End Sub
登録:
コメント (Atom)
-
エクスポート設定なんかをテーブルにまとめておいて一括処理したいときに使う
-
AccessVBAで直接Excelを編集するのと、AccessVBAでExcelを編集するExcelVBAを実行するのはどっちが楽なんだろう。