Sub Main()
Dim ObjConn As Object, RS As Object, Files
Dim StrRequest As String, Path As String
Dim I as Long, It, n as Long, tieude()
Path = ThisWorkbook.Path
Files = Array("QS_MAIL_HISTORY_SMS.xls", "QS_MAIL_HISTORY_EMAIL.xls")
Set RS = CreateObject("ADODB.Recordset")
Workbooks.Add
For I = 0 To UBound(Files)
Set ObjConn = GetExcelConnection(Path & "\" & Files(I), 1)
StrRequest = "SELECT * FROM [Worksheet$A1:AE10000]"
RS.Open StrRequest, ObjConn, 3, 1
For Each It In RS.Fields
n = n + 1
ReDim Preserve tieude(1 To n)
tieude(n) = It.Name
Next
ActiveWorkbook.Sheets("Sheet" & I + 1).[A1].Resize(, n) = tieude
ActiveWorkbook.Sheets("Sheet" & I + 1).[A2].CopyFromRecordset RS
ObjConn.Close
n = 0: Erase tieude
Next
Set RS = Nothing
End Sub
Function GetExcelConnection(ByVal Path As String, Optional ByVal Header As Boolean = True)
Dim StrConn As String, ObjConn As Object, Pro As String, Ext As String
Set ObjConn = CreateObject("ADODB.Connection")
If Application.Version < 12 Then
Pro = "Provider=Microsoft.JET.OLEDB.4.0;"
Ext = ";Extended Properties=""Excel 8.0;"
Else
Pro = "Provider=Microsoft.ACE.OLEDB.12.0;"
Ext = ";Extended Properties=""Excel 12.0;"
End If
StrConn = Pro & "Data Source=" & Path & Ext & "HDR=" & IIf(Header, "Yes", "No") & ";IMEX=1"";"
ObjConn.Open StrConn
Set GetExcelConnection = ObjConn
End Function
