Em có sưu tầm được 1 đoạn code trên GPE như sau:
Trước giờ em chạy bình thường, hôm nay chạy báo lỗi "run time error 91 object variable or with block variable not set" ở dòng:
Em chuyển file sang máy tính khác vẫn bị. Mong các anh chị giúp đỡ, em xin cảm ơn
Mã:
Sub GetdatawebAccuweather(ByVal Tram As String, fDate As Date, eDate As Date)
Application.ScreenUpdating = False
Dim hrq As Object, html As Object, url As String, dated As Date, row As Object, cell As Object, a As Object, reg As Object, str As String, id As String
Dim i As Long, j As Long, k As Long, nmonth As Long, wf As WorksheetFunction, url2 As String, url3 As String, id2 As String, lcal As String
Dim dArr(), dArr1(), R As Long
Dim Dk As Boolean
Set wf = WorksheetFunction: Set hrq = CreateObject("msxml2.xmlhttp"): Set html = CreateObject("htmlfile")
url = "https://www.accuweather.com/vi/vn/thai-binh/356177/january-weather/356177?monyr="
R = Range("A" & Rows.count).End(xlUp).row + 1
If R > 5 Then Sheet15.Range("K12:N" & R).ClearContents
R = eDate - fDate + 1: ReDim dArr(1 To R, 1 To 8): ReDim dArr1(1 To R, 1 To 4)
With hrq
.Open "POST", "https://www.accuweather.com/vi/search-locations", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send "s=" & Tram
Do While .readystate <> 4
DoEvents
Loop
html.body.innerhtml = .responsetext
End With
Dim RX As Object
Set RX = CreateObject("vbscript.regexp")
RX.Pattern = "^(?:https://www.accuweather.com)/.+/(\w+)/[^\/]+/(\w+)$": RX.Global = True
For Each a In html.getelementsbytagname("a")
If RX.Test(a.href) And (a.innertext Like "*" & Tram & "*" Or a.innertext Like "*" & Split(Tram, ",")(0) & "*") Then '
id = RX.Replace(a.href, "$1")
id2 = RX.Replace(a.href, "$2")
End If
Next
RX.Global = True
RX.Pattern = "\/\d+"
url2 = Replace(Replace(RX.Replace(url, "@@"), "@@", "/" & id, , 1), "@@", "/" & id2)
For nmonth = 0 To DateDiff("m", wf.EoMonth(fDate, -1) + 1, wf.EoMonth(eDate, 0) + 1)
url3 = url2 & Format(wf.eDate(fDate, nmonth), "m/d/yyyy") & "&view=table"
With hrq
.Open "GET", url3, False
.send
Do While .readystate <> 4
DoEvents
Loop
html.body.innerhtml = .responsetext
End With
For Each row In html.getelementsbytagname("tbody")(0).Rows
dated = DateValue(Split(Trim(row.Cells(0).innertext), " ")(1) & "/" & Year(wf.eDate(fDate, nmonth)))
If dated >= fDate And dated <= eDate Then
i = i + 1: j = 0: k = k + 1
For Each cell In row.Cells
j = j + 1
dArr(i, j) = cell.innertext:
Next
End If
Next
Next nmonth
Sheet15.Range("K12").Resize(k, 4) = dArr1
Set hrq = Nothing: Set html = Nothing
Application.ScreenUpdating = True
Set RX = Nothing
End Sub
Mã:
For Each row In html.getelementsbytagname("tbody")(0).Rows
