'テキストファイルを複数のファイルに分割するマクロ

Sub DivideTextFile()
    Const RowCount = 65536
    Dim vFileName As Variant
    Dim sFileName As String, sFileType As String
    Dim sBuffer As String
    Dim hFile_In As Long, hFile_Out As Long
    Dim iCount As Long, i As Long

    On Error GoTo ErrorHandler

    If MsgBox("テキストファイルを " & RowCount & " 行で分割します。" & _
        "テキストファイルと同じフォルダにある ""テキストファイル名_番号""" & _
        " の形式のファイルは警告なしに上書きされます。", _
        vbExclamation Or vbOKCancel) <> vbOK Then Exit Sub

    vFileName = Application.GetOpenFilename( _
        "テキストファイル (*.txt;*.csv),*.txt;*.csv," & _
        "すべてのファイル (*.*),*.*")
    If VarType(vFileName) <> vbString Then Exit Sub

    sFileName = vFileName
    For i = Len(sFileName) To 1 Step -1
        If Mid(sFileName, i, 1) = "." Then
            sFileType = Mid(sFileName, i)
            sFileName = Left(sFileName, i - 1)
            Exit For
        End If
    Next

    hFile_In = FreeFile()
    Open vFileName For Input As #hFile_In
    Do Until EOF(hFile_In)
        iCount = iCount + 1
        hFile_Out = FreeFile()
        Open sFileName & "_" & Format(iCount, "000") & sFileType _
            For Output As #hFile_Out
        For i = 1 To RowCount
            Line Input #hFile_In, sBuffer
            Print #hFile_Out, sBuffer
            If EOF(hFile_In) Then Exit For
        Next
        Close #hFile_Out
    Loop

    Close #hFile_Out

    MsgBox iCount & " 個のファイルを作成しました。", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox Error(Err) & " (" & Err & ")", vbExclamation
    If hFile_In <> 0 Then Close #hFile_In
    If hFile_Out <> 0 Then Close #hFile_Out
End Sub