Option Explicit
Public Cn As Variant, Rec As Variant, mySQL As String
===============================================================
'DUNG ADODC TRICH DU LIEU
Sub Getdata(ByVal FName As String, ByVal hs As String)
Dim dich As Range
Cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FName & _
";Persist Security Info=False; Extended Properties=Excel 8.0;"
Cn.Open
mySQL = "SELECT * FROM [Data]"
Rec.Open mySQL, Cn, adOpenKeyset, adLockOptimistic
Set dich = TH.[b56536].End(xlUp).Offset(1)
dich.CopyFromRecordset Rec
dich.Offset(, -1).Resize(Rec.RecordCount) = hs
Rec.Close
Cn.Close
End Sub
===============================================================
'TONG HOP THEO DANH SACH
Sub THDL()
Dim i
Dim hs, ten As String
Set Cn = New ADODB.Connection
Set Rec = New ADODB.Recordset
TH.[a2:c56536].ClearContents
For i = 1 To T.Range("DST").Cells.Count
hs = T.Range("DST").Rows(i)
ten = ThisWorkbook.Path & "\DATA\" & hs
Getdata ten, hs
Next
Set Rec = Nothing
Set Cn = Nothing
End Sub
===============================================================
'TONG HOP TAT CA CAC FILE TRONG THU MUC DATA
Sub TH_ALL()
Dim fs, i
Dim hs, ten As String
Set Cn = New ADODB.Connection
Set Rec = New ADODB.Recordset
TH.[a2:c56536].ClearContents
Set fs = Application.FileSearch
With fs
.LookIn = ThisWorkbook.Path & "\DATA"
.Filename = "*.xls"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
ten = .FoundFiles(i)
hs = Right(.FoundFiles(i), Len(.FoundFiles(i)) _
- InStrRev(.FoundFiles(i), "\"))
hs = Replace(hs, ".xls", "")
Getdata ten, hs
Next i
Else
MsgBox "There were no files found."
End If: End With
Set Rec = Nothing: Set Cn = Nothing
End Sub
===============================================================
Sub xoa()
TH.[a2:c56536].ClearContents
End Sub
