hiko-blog

VBA業務改善

MENU

件数の多いcsvファイルを、1、000件ごとに分割する(ドラッグ&ドロップ対応)

Option Explicit
Dim a, c, cn, cv, f, i, n, so, wa, x, y
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments

If wa.Count <> 1 or LCase(so.GetExtensionName(wa(0))) <> "csv" Then
MsgBox("ドラッグ&ドロップできるのは、csvファイル1つだけです")

WScript.Quit
End If

f = Left(wa(0), InStrRev(wa(0), "\"))
n = so.GetBaseName(wa(0))
Set cv = so.OpenTextFile(wa(0), 1)
x = cv.ReadLine
c = 0

Do Until cv.AtEndOfStream
c = c + 1
y = Right("00" & CStr(c), 2)
Set cn = so.OpenTextFile(f & n & "_" & y & ".csv", 2, True)
cn.WriteLine x
For i = 0 to 1000
a = cv.ReadLine
cn.WriteLine a

If cv.AtEndOfStream = True Then
Exit For
End If

Next
cn.Close
Set cn = Nothing
Loop

cv.Close
Set cv = Nothing
Set wa = Nothing
Set so = Nothing
MsgBox("分割完了")