Option Explicit
'Author: Nguyen Duy Tuan - http://bluesofts.net
'Kien thuc code trong file nay ban xem link: https://www.youtube.com/watch?v=OSfcpLGVLOk
Sub LayTyGia()
Range("J6:L6").Value = "Waiting..."
Range("J6:L6").Value = LayTyGiaTheoNgay(Range("J2").Value, Range("J3").Value)
End Sub
Function LayTyGiaTheoNgay(dNgay As Date, strNgoaiTe As String)
Dim qry As QueryTable, rng As Range, I As Long, arrRes(1 To 3)
LayTableTuWeb dNgay
Set qry = ThisWorkbook.Sheets("webdata").QueryTables(1)
Set rng = qry.ResultRange
For I = 3 To rng.Rows.Count
If StrComp(rng.Rows(I).Cells(, 2).Value, strNgoaiTe, vbTextCompare) = 0 Then
arrRes(1) = rng.Rows(I).Cells(, 3).Value
arrRes(2) = rng.Rows(I).Cells(, 4).Value
arrRes(3) = rng.Rows(I).Cells(, 5).Value
Exit For
End If
Next
LayTyGiaTheoNgay = arrRes
End Function
Sub LayTableTuWeb(ByVal dNgay As Date)
Dim qry As QueryTable
Dim sh As Worksheet
Dim CnnStr As String
Set sh = ThisWorkbook.Sheets("webdata")
'Xoa querytable truoc do
XoaQT sh
CnnStr = "URL;https://portal.vietcombank.com.vn/UserControls/TVPortal.TyGia/pListTyGia.aspx?txttungay=" & Format(dNgay, "dd/mm/yyyy")
Set qry = sh.QueryTables.Add(CnnStr, sh.Range("A1"))
'Query
qry.WebSelectionType = xlSpecifiedTables
qry.WebFormatting = xlWebFormattingNone
qry.WebTables = """ctl00_Content_ExrateView""" 'Co the nhieu hon mot table
qry.Refresh False 'Load du lieu
End Sub
Sub XoaQT(sh As Worksheet)
Dim qry As QueryTable
On Error Resume Next 'Bo qua loi
For Each qry In sh.QueryTables
qry.ResultRange.ClearContents 'Xoa data trong vung table
qry.Delete 'Xoa QueryTable
Next
End Sub