XLA routines: EE_MergeCSV

Nick's picture
EE_MergeCSV merges 2 csvs... To merge more, simply call it again with the merged result from the previous merge.
Function EE_MergeCSV(strCSVFile1 As String, strCSVFile2 As String, strMergedFilePathnName As String) As Boolean
'- File1
'- File2
'- mergedFileName
'- checks headings are the same
'- returns True if no errors
    Dim wbk1 As Workbook
    Dim wbk2 As Workbook
    Dim hdr1 As range
    Dim hdr2 As range
    Dim x As Integer
 
'http://excelexperts.com/xla-routines-eeMergeCSV    for updates on this function

    If strCSVFile1 = "" Or strCSVFile2 = "" Then
        GoTo ErrH
    End If
 
    On Error GoTo ErrH
        Set wbk1 = Workbooks.Open(strCSVFile1)
        Set wbk2 = Workbooks.Open(strCSVFile2)
    Err.Clear: On Error GoTo 0: On Error GoTo -1
 
    Set hdr1 = wbk1.Worksheets(1).range("A1").CurrentRegion.Rows(1)
    Set hdr2 = wbk2.Worksheets(1).range("A1").CurrentRegion.Rows(1)
 
    'Chk if header count is same
    If hdr1.Cells.Count <> hdr2.Cells.Count Then
        GoTo ErrH
    End If
 
    'Chk if headers match
    For x = 1 To hdr1.Columns.Count
        If hdr1.Cells(1, x) <> hdr2.Cells(1, x) Then
            GoTo ErrH
        End If
    Next x
 
    'Merge
    wbk2.Worksheets(1).range("A1").CurrentRegion.Offset(1).Copy
    With wbk1.Worksheets(1).range("A1")
        .Offset(.CurrentRegion.Rows.Count).PasteSpecial xlPasteValues
    End With
 
    'wbkCSV.SaveAs ThisWorkbook.Path & "\" & Replace(strCSVfileName, ".csv", "") & ".csv", xlCSV
    Application.DisplayAlerts = False
    wbk1.SaveAs Replace(strMergedFilePathnName, ".csv", "") & ".csv", xlCSV
    Application.DisplayAlerts = True
 
    EE_MergeCSV = True
    GoTo ExitH
 
ErrH:
    EE_MergeCSV = False
    Err.Clear: On Error GoTo 0: On Error GoTo -1
ExitH:
    On Error Resume Next
        wbk1.Close False
        wbk2.Close False
    On Error GoTo 0
 
    Set wbk1 = Nothing
    Set wbk2 = Nothing
End Function