Sub GopFiles()
Dim newFileName As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
newFileName = ThisWorkbook.Path & "\MergedCSVFiles.csv"
If MergeCSVFiles(ListFiles, newFileName, True, False) = False Then Exit Sub
MsgBox "Xong."
'Mo file
CreateObject("Shell.Application").Open (newFileName)
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
Function MergeCSVFiles(fileNames() As Variant, newFileName As String, Optional headers As Boolean = True, Optional addNewLine As Boolean = False) As Boolean
'# fileNames: Danh sách tên file - array
'# newFilename: Tên file moi sau khi merge
'# headers: Du Lieu Co Dong Tieu De
'# addNewLine: Có thêm dòng moi cuoi file hay không
Dim fileName As Variant, textData As String, fileNo As Long, result As String
Dim addLastLine As Boolean, RefirstHeader As Boolean, chCode As Long
'Kiem tra array xem co chon file de gop khong.
If UBound(fileNames) = 0 Then
MergeCSVFiles = False
Exit Function
End If
For Each fileName In fileNames
fileNo = FreeFile
Open fileName For Input As #fileNo
textData = Input$(LOF(fileNo), fileNo) 'Doc toan bo File
Close #fileNo
chCode = Asc(Right(textData, 1))
If chCode <> 10 And chCode <> 13 Then textData = textData & vbNewLine
If addLastLine Then result = result & vbNewLine
If RefirstHeader Then
result = result & Right(textData, Len(textData) - InStr(textData, vbNewLine) - 1)
Else
result = result & textData
End If
If headers Then RefirstHeader = True
If addNewLine Then addLastLine = True
Next fileName
fileNo = FreeFile
Open newFileName For Output As #fileNo
Print #fileNo, result
Close #fileNo
MergeCSVFiles = True
End Function
Function ListFiles() As Variant() 'Array of Files
Dim oFSO As Object, oFolder As Object, oFile As Object, arFiles()
Dim i As Long, selectedFolder As String
'On Error GoTo ErrHandler
With Application.FileDialog(4) '(msoFileDialogFolderPicker)
.Title = "Chon Folder chua file CSV can gop"
.Show
If .SelectedItems.Count = 0 Then
ReDim ListFiles(0)
GoTo ExitHandler
End If
selectedFolder = .SelectedItems(1)
End With
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(selectedFolder)
If oFolder.Files.Count = 0 Then
MsgBox "Folder khong co file."
ReDim ListFiles(0)
GoTo ExitHandler
End If
ReDim arFiles(1 To oFolder.Files.Count)
i = 0
For Each oFile In oFolder.Files
If Right(oFile, 4) = ".csv" Then 'Chi lay file CSV
i = i + 1
arFiles(i) = oFile
End If
Next
If i = 0 Then 'Khong co file CSV
ReDim ListFiles(0)
MsgBox "Folder khong co chua file CSV", vbExclamation, "Thông báo"
Else
ReDim Preserve arFiles(1 To i)
ListFiles = arFiles()
End If
ExitHandler:
Set oFSO = Nothing
Set oFolder = Nothing
Set oFile = Nothing
Erase arFiles
Exit Function
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Function
