After long time, VBA code is not working properly today.
Got run-time error '1004':application-defined or object-defined error
When I clicked Debug
It showed me at Sheet1.Cells(rCount, ItemIndex + 1).Value = Node.nodeTypedValue
I think Bing changed its fields, do not know exactly.
Here is the code
Dim rCount As Long
Public Sub GetDataFromBing(ByVal strurl As String)
Dim xDOC As DOMDocument
Dim XMLHttpRequest As XMLHTTP
Dim response As String
Dim URL As String
Dim sTemperature As String
'URL = "http://www.bing.com/search?q=Aaron%20BentDirector%20Business%20Development%20at%20Analyze%E2%80%A6locationindustry&qs=&format=rss"
URL = strurl
Set XMLHttpRequest = New MSXML2.XMLHTTP
With XMLHttpRequest
.Open "GET", URL, False
.send
End With
Set xDOC = New DOMDocument
Do Until xDOC.readyState = 4
Loop
xDOC.LoadXML (XMLHttpRequest.responseText)
Set xNode = xDOC.SelectSingleNode("//channel")
If Not xNode Is Nothing Then
Dim strValue As String
For FieldIndex = 1 To xNode.ChildNodes.Length
If FieldIndex > 5 Then
Set items = xNode.ChildNodes(FieldIndex)
If Not items Is Nothing Then
For ItemIndex = 0 To items.ChildNodes.Length - 1
Set Node = items.ChildNodes(ItemIndex)
Sheet1.Cells(rCount, ItemIndex + 1).Value = Node.nodeTypedValue
Next ItemIndex
End If
rCount = rCount + 1
End If
Next FieldIndex
Else
rCount = rCount + 1
End If
On Error Resume Next
End Sub
Public Sub loadURL()
Dim sh As Worksheet
Dim rw As Range
Dim RowCount As Long
RowCount = 0
rCount = 3
Set sh = ActiveSheet
For Each rw In sh.Rows
If RowCount >= 2 Then
If sh.Cells(rw.Row, 1).Value = "" Then
Exit For
Else
GetDataFromBing sh.Cells(rw.Row, 1).Value
End If
End If
RowCount = RowCount + 1
Next rw
MsgBox (RowCount - 2)
End Sub
Got run-time error '1004':application-defined or object-defined error
When I clicked Debug
It showed me at Sheet1.Cells(rCount, ItemIndex + 1).Value = Node.nodeTypedValue
I think Bing changed its fields, do not know exactly.
Here is the code
Dim rCount As Long
Public Sub GetDataFromBing(ByVal strurl As String)
Dim xDOC As DOMDocument
Dim XMLHttpRequest As XMLHTTP
Dim response As String
Dim URL As String
Dim sTemperature As String
'URL = "http://www.bing.com/search?q=Aaron%20BentDirector%20Business%20Development%20at%20Analyze%E2%80%A6locationindustry&qs=&format=rss"
URL = strurl
Set XMLHttpRequest = New MSXML2.XMLHTTP
With XMLHttpRequest
.Open "GET", URL, False
.send
End With
Set xDOC = New DOMDocument
Do Until xDOC.readyState = 4
Loop
xDOC.LoadXML (XMLHttpRequest.responseText)
Set xNode = xDOC.SelectSingleNode("//channel")
If Not xNode Is Nothing Then
Dim strValue As String
For FieldIndex = 1 To xNode.ChildNodes.Length
If FieldIndex > 5 Then
Set items = xNode.ChildNodes(FieldIndex)
If Not items Is Nothing Then
For ItemIndex = 0 To items.ChildNodes.Length - 1
Set Node = items.ChildNodes(ItemIndex)
Sheet1.Cells(rCount, ItemIndex + 1).Value = Node.nodeTypedValue
Next ItemIndex
End If
rCount = rCount + 1
End If
Next FieldIndex
Else
rCount = rCount + 1
End If
On Error Resume Next
End Sub
Public Sub loadURL()
Dim sh As Worksheet
Dim rw As Range
Dim RowCount As Long
RowCount = 0
rCount = 3
Set sh = ActiveSheet
For Each rw In sh.Rows
If RowCount >= 2 Then
If sh.Cells(rw.Row, 1).Value = "" Then
Exit For
Else
GetDataFromBing sh.Cells(rw.Row, 1).Value
End If
End If
RowCount = RowCount + 1
Next rw
MsgBox (RowCount - 2)
End Sub
Last edited: