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

Option Explicit

Private Const OF_READ = &h0
Private Const OF_WRITE = &h1
Private Const OF_SHARE_EXCLUSIVE = &h10
Private Const HFILE_ERROR = -1

Private Const BufferSize = 8192

Private Declare Function lcreat Lib "kernel32" Alias "_lcreat" ( _
    ByVal lpszFileName As String, ByVal fnAttribute As Long) As Long
Private Declare Function lopen Lib "kernel32" Alias "_lopen" ( _
    ByVal lpzsFileName As String, ByVal fnOpenMode As Long) As Long
Private Declare Function lclose Lib "kernel32" Alias "_lclose" ( _
    ByVal hFile As Long) As Long
Private Declare Function lread Lib "kernel32" Alias "_lread" ( _
    ByVal hFile As Long, ByRef lpBuffer As Any, ByVal cbRead As Long) As Long
Private Declare Function lwrite Lib "kernel32" Alias "_lwrite" ( _
    ByVal hFile As Long, ByRef lpBuffer As Any, ByVal cbWrite As Long) As Long

Function CopyFiles(vFiles As Variant, sFile_Out As String) As Long
    Dim hFile_In As Long, hFile_Out As Long
    Dim vFile As Variant
    Dim iBuf(0 To (BufferSize - 1) \ 4) As Long
    Dim iRead As Long
    Dim iRet As Long

    CopyFiles = -1

    On Error GoTo ErrorHandler

    If Dir$(sFile_Out) <> "" Then
        hFile_Out = lopen(sFile_Out, OF_WRITE Or OF_SHARE_EXCLUSIVE)
        If hFile_Out = HFILE_ERROR Then
            Exit Function
        End If
        iRet = lclose(hFile_Out)
        If iRet = HFILE_ERROR Then
            Exit Function
        End If
    End If

    hFile_Out = lcreat(sFile_Out, 0)
    If hFile_Out = HFILE_ERROR Then
        Exit Function
    End If
    iRet = lclose(hFile_Out)
    If iRet = HFILE_ERROR Then
        Exit Function
    End If

    hFile_Out = lopen(sFile_Out, OF_WRITE Or OF_SHARE_EXCLUSIVE)
    If hFile_Out = HFILE_ERROR Then
        Exit Function
    End If

    For Each vFile In vFiles
        hFile_In = lopen(CStr(vFile), OF_READ)
        If hFile_In = HFILE_ERROR Then
            iRet = lclose(hFile_Out)
            Exit Function
        End If

        Do
            iRead = lread(hFile_In, iBuf(0), BufferSize)
            If iRead = 0 Then
                Exit Do
            End If
            iRet = lwrite(hFile_Out, iBuf(0), iRead)
            If iRet <> iRead Then
                iRet = lclose(hFile_Out)
                iRet = lclose(hFile_In)
                Exit Function
            End If
        Loop While iRead = BufferSize

        iRet = lclose(hFile_In)
        If iRet = HFILE_ERROR Then
            iRet = lclose(hFile_In)
            Exit Function
        End If
        hFile_In = 0
    Next

    iRet = lclose(hFile_Out)
    If iRet = HFILE_ERROR Then
        iRet = lclose(hFile_Out)
        Exit Function
    End If
    hFile_Out = 0

    CopyFiles = 0
    Exit Function
ErrorHandler:
    If hFile_Out <> 0 Then iRet = lclose(hFile_Out)
    If hFile_In <> 0 Then iRet = lclose(hFile_In)
End Function


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

Sub Test_CopyFiles()
    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 = CopyFiles(vFiles, sFile_Out)
    If iRet = -1 Then
        MsgBox "エラーが発生しました。", vbExclamation
    End If
End Sub