'複数のテキストファイルを1つのファイルへコピーするマクロ

Option Explicit

'複数のテキストファイルを1つのファイルへコピーする関数

'空白行はコピーしません。

'引数
'vFiles   : コピーするファイル名。Varian型配列で指定します。
'sFile_Out: コピー先ファイル名。

'戻り値
'    -1: 失敗
'その他: コピーした行数

Function CopyTextFiles(vFiles As Variant, sFile_Out As String) As Long
    Dim hFile_In As Long, hFile_Out As Long
    Dim vFile As Variant
    Dim sBuffer As String
    Dim iCount As Long

    CopyTextFiles = -1
    iCount = 0

    On Error GoTo ErrorHandler

    hFile_Out = FreeFile()
    Open sFile_Out For Output Lock Read Write As #hFile_Out

    For Each vFile In vFiles
        hFile_In = FreeFile()
        Open vFile For Input As #hFile_In
        Do Until EOF(hFile_In)
            Line Input #hFile_In, sBuffer
            If Len(sBuffer) <> 0 Then
                Print #hFile_Out, sBuffer
                iCount = iCount + 1
            End If
        Loop
        Close #hFile_In
        hFile_In = 0
    Next

    Close #hFile_Out
    hFile_Out = 0

    CopyTextFiles = iCount
    Exit Function

ErrorHandler:
    If hFile_Out <> 0 Then Close #hFile_Out
    If hFile_In <> 0 Then Close #hFile_In
    Exit Function
End Function


'C:\Work1\a.txt と C:\Work2\a.txt を C:\Work3\a.txt へコピーします。

Sub Test_CopyTextFiles()
    Dim vFiles() As String
    Dim sFile_Out As String
    Dim iRet As Long

    ReDim vFiles(1 To 2)
    vFiles(1) = "C:\Work1\a.txt"
    vFiles(2) = "C:\Work2\a.txt"
    sFile_Out = "C:\Work3\a.txt"
    iRet = CopyTextFiles(vFiles, sFile_Out)
    If iRet = -1 Then
        MsgBox "エラーが発生しました。", vbExclamation
    Else
        MsgBox CStr(iRet) & " 行をコピーしました。"
    End If
End Sub