I have an application which extracts data from a website and loads it into a server table. When I run the application first time in a day it is showing a popup and asking for Yes/No input. How to overcome this popup as I wanted to auto schedule the application and run it without manual intervention.
Public Sub Resolve_Date()
Dim XMLReq As MSXML2.XMLHTTP60 = New MSXML2.XMLHTTP60
Dim HTMLDoc = New mshtml.HTMLDocument
'Dim htmlbody As HtmlDocument.body = New HTML
Dim ObjXL As New Excel.Application
Dim Table As mshtml.IHTMLElement
Dim Tr As mshtml.IHTMLElement
Dim Tc As mshtml.IHTMLElement
Dim Trs As mshtml.IHTMLElementCollection
Dim URL As String
Dim x As Integer, y As Integer
URL = "https://tt.wiki.com/search?category=&assigned_group=3p-asin"
XMLReq.open("GET", URL, False) '--pop up is appearing here
XMLReq.send()
If XMLReq.status <> 200 Then
msgBox("Error" & vbNewLine & XMLReq.status & " - " & XMLReq.statusText)
Exit Sub
End If
Dim HTMLDoc1 As mshtml.IHTMLDocument = HTMLDoc
HTMLDoc1.write("<html><body>test</body></html>")
HTMLDoc1.close()
HTMLDoc = HTMLDoc1
HTMLDoc.body.innerHTML = XMLReq.responseText
''msgBox(HTMLDoc.body.innerHTML)
'MsgBox(HTMLDoc.body.innerHTML)
XMLReq = Nothing
Table = HTMLDoc.getElementById("search_results")
Trs = Table.getElementsByTagName("tr")
For Each Tr In Trs
--code to insert data into Table
Next Tr
I could do more if I knew what you were doing with the table... probably avoid the obsolte MsHtml API (HTMLDocument and friends) entirely. But with just the context we have, this is a rewrite that uses at least some more modern techniques and considerably simplifies the code.
Public Sub Resolve_Date()
Dim URL As String = "https://tt.wiki.com/search?category=&assigned_group=3p-asin"
Dim results As String = ""
Try
Using wc As New WebClient()
results = wc.DownloadString(URL)
End Using
Catch Ex As Exception
MsgBox($"Error{vbNewLine}{Ex.Message}")
Exit Sub
End Try
Dim HTMLDoc As New mshtml.HTMLDocument()
HTMLDoc.Write(results);
Dim Table As mshtml.IHTMLElement = HTMLDoc.getElementById("search_results")
Dim Trs As mshtml.IHTMLElementCollection = Table.getElementsByTagName("tr")
Dim ObjXL As New Excel.Application
Dim x As Integer, y As Integer
For Each Tr As mshtml.IHTMLElement In Trs
' code to insert data into Table
Next Tr
End Sub
Related
In my program, I get a series of information instantly from several Internet addresses on a one-to-one basis, but this is delay time and this delay may be part of the momentary information loss . I want to get all the information from all URLs at the same time. Is it possible?
This is part of my program:
For i As Integer = 0 To 1000
Dim wreq As System.Net.HttpWebRequest =
System.Net.WebRequest.Create("http://www........." + slink(i))
wreq.AutomaticDecompression = Net.DecompressionMethods.GZip
Dim wres As System.Net.WebResponse = wreq.GetResponse
Dim s As System.IO.Stream = wres.GetResponseStream
Dim sr As New System.IO.StreamReader(s)
Dim html As String = sr.ReadToEnd
Dim sOutput As String = html
Dim file As System.IO.StreamWriter
Dim masir As String = TextBox1.Text & "tm\Archive\" + slink(i).ToString
file = My.Computer.FileSystem.OpenTextFileWriter(masir, True)
file.Write(html)
file.Close()
Next
I want to create POST request for my ServiceNow Instance API. But I don't know how to use library VBA-Web.
I want to create a row in my table in ServiceNow.
My code:
Sub ToRequestSN()
Dim Body As New Dictionary
Body.Add "u_any_string", "test"
Body.Add "u_any_numeral", 12
Dim Client As New WebClient
Dim Response As WebResponse
Set Response = Client.PostJson("https://instance.sn.ru/api/now/table/u_table_test", Body)
Debug.Print Response.Content
End Sub
But I got this message -
{"error":{"message":"User Not Authenticated","detail":"Required to provide Auth information"},"status":"failure"}
How I can log in using VBA-Web?
I found solution. I did send selected mail (email of sender) and pass to Service Now.
Sub RequestToSN()
Dim Client As New WebClient
Dim Response As WebResponse
Dim Auth As New HttpBasicAuthenticator
Dim Body As New Dictionary
Dim myOlSel As Outlook.Selection
Dim oMail As Outlook.MailItem
Dim myOlExp As Outlook.Explorer
MsgTxt = ""
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
If myOlSel.Item(x).Class = OlObjectClass.olMail Then
Set oMail = myOlSel.Item(x)
MsgTxt = MsgTxt & oMail.SenderName
''Date = Date & oMail.CreationTime
End If
Next x
Body.Add "u_any_string", MsgTxt
Body.Add "u_any_numeral", 123
Auth.Setup _
Username:="user", _
Password:="user"
Set Client.Authenticator = Auth
Set Response = Client.PostJson("https://service.sn.com/api/now/table/u_table_test", Body)
End Sub
I need to make status message on excel after calling the api . status message in xml format so how to parse the data accurately.
Below given codes are using to get API info
Sub Test()
Dim xmlHTTP As Object
Set xmlHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
myURL = "http://xxxxxxxxxxxxx:15555/gateway/StatusTracking/1.0/shipment/tracking?housebill=cvvvv"
xmlHTTP.Open "GET", myURL, False
xmlHTTP.SetRequestHeader "APIKey", "xxxx-xxx-xxxxx-xxxx-xxxx"
xmlHTTP.SetRequestHeader "Accept", "application/json"
xmlHTTP.Send
Dim strReap As String
strReap = hReq.ResponseText
Dim xmlDoc As New MSXML2.DOMDocument
If Not xmlDoc.LoadXML(strReap) Then
MsgBox "Load error"
End If
Dim xnodelist As MSXML2.IXMLDOMNodeList
Set xnodelist = xmlDoc.getElementsByTagName("ShipmentTracking")
Dim xnode As MSXML2.IXMLDOMNode Set xnode = xnodelist.Item(0)
Dim obAtt1 As MSXML2.IXMLDOMAttribute
Dim obAtt2 As MSXML2.IXMLDOMAttribute
Dim xChild As MSXML2.IXMLDOMNode
Dim intRow As Integer
intRow = 2
Dim strCol1 As String
strCol1 = "A"
Dim strCol2 As String
strCol1 = "B"
Dim Shipment As String
For Each xChild In xnode.ChildNodes
Set obAtt1 = xChild.Attributes.getNamedItem("Shipment")
ws.Cells(intRow, 2) = obAtt1
intRow = intRow + 1
Next xChild
Set hReq = Nothing
Set xmlDoc = Nothing
End Sub
normal xml status message format given below
<Shipment tracking>
<type/>
<object/>
<properties/>
<Shipment>
<Origin/>
<type/>
<properties/>
<LocationCode/>
<CountryCode/>
</Shipment>
</Shipment tracking>
I am newbie in vba programming and i tried with this code but not working fine. I just want output,from shipment(xmltagname) to end in excel sheet. Please help me on this
You have written code Attributes.getNamedItem when in fact you have no attributes. Also to query for elements I'd prefer selectNodes and selectSingleNode instead of getElementsByTagName.
So try
xChild.selectSingleNode("Shipment")
and change the declaration for the receiving variable from IXMLDOMAttribute to IXMLDOMElement
I'm trying to download the XML data outputted by Google Map API. After I download and store that data in a variable, I would like to parse that data to get a specific information. Here is the link to a sample output : http://maps.googleapis.com/maps/api/geocode/xml?latlng=34.6465583799,-101.57620022
Dim oXMLHTTP As Object
Dim sPageHTML As String
Dim sURL As String
Dim XmlMapResponse As String
sURL = "http://maps.googleapis.com/maps/api/geocode/xml?latlng=" + Selection.Value
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.send
XmlMapResponse = oXMLHTTP.responseText
Once the XML data has been downloaded, I tried to parse out "79088" which is the postal code by doing this :
Dim strXML As String
Dim xNode As IXMLDOMNode
Dim XDoc As MSXML2.DOMDocument
strXML = XmlMapResponse
Set XDoc = New MSXML2.DOMDocument
If Not XDoc.LoadXML(strXML) Then
Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason
End If
Set xNode = XDoc.SelectNodes("/GeocodeResponse/result/address_component/long_name")
MsgBox xNode.InnerText(6)
I don't know why xNode.InnerText(6) doesn't work for me. In VB.NET it works fine.
Any help?
SelectNodes returns a node list, not a single node.
Maybe you meant to use:
Set xNode = XDoc.SelectNodes( _
"/GeocodeResponse/result/address_component/long_name")(6)
As previously mentioned SelectNodes returns a node list which caused an error when I attempted to run this code.You should either:
change xNode to a IXMLDOMNodeList
Select only a single node from the list (as suggested by Tim)
Change the function to XDoc.selectSingleNode("/XPATH")
Beyond that, The IXMLDOMNode Object does not appear to support an InnerText function. use xNode.Text instead.
The following code runs without errors and returns the first result (8379)
Sub test()
Dim oXMLHTTP As Object
Dim sPageHTML As String
Dim sURL As String
Dim XmlMapResponse As String
sURL = "http://maps.googleapis.com/maps/api/geocode/xml?latlng=" + "34.6465583799,-101.57620022"
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.send
XmlMapResponse = oXMLHTTP.responseText
Dim strXML As String
Dim xNode As MSXML2.IXMLDOMNode
Dim XDoc As MSXML2.DOMDocument60
strXML = XmlMapResponse
Set XDoc = New MSXML2.DOMDocument60
If Not XDoc.LoadXML(strXML) Then
Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason
End If
Set xNode = XDoc.SelectSingleNode("/GeocodeResponse/result/address_component/long_name")
MsgBox xNode.Text
End Sub
Hello I am trying to get the "title" element out of this table:
<td class="field_domain"><strong>Plantar</strong><strong>Fasciitis</strong>HeelPain.com</td>
Here is my code that almost works but not quite:
Dim web As New HtmlAgilityPack.HtmlWeb()
Dim htmlDoc As HtmlAgilityPack.HtmlDocument = web.Load("https://www.expireddomains.net/domain-name-search/?o=domainpop&r=d&q=plantar+fasciitis")
Dim html As String = htmlDoc.DocumentNode.OuterHtml
Dim tabletag = htmlDoc.DocumentNode.SelectNodes("//td[#class='field_domain']")
For Each t In tabletag
Dim var = t.SelectSingleNode("//td[#class='title']").InnerText
MessageBox.Show(var)
Next
This did the trick:
Dim web As New HtmlAgilityPack.HtmlWeb()
Dim htmlDoc As HtmlAgilityPack.HtmlDocument = web.Load("https://www.expireddomains.net/domain-name-search/?o=domainpop&r=d&q=plantar+fasciitis")
Dim html As String = htmlDoc.DocumentNode.OuterHtml
For Each linkItem As HtmlNode In htmlDoc.DocumentNode.SelectNodes("//td[#class='field_domain']")
Dim name = linkItem.Element("a").InnerText
MessageBox.Show(name)
Next