auto click yes on certificate Security warnings and Windows Security Warnings - vba

I wrote a VBA code which would take its input(url) from a column of an excel sheet, and return its http status code. The problem I face is that some urls are having Certificate issues and for some websites I am getting Windows Security Alerts. I want a simple solution to automatically click on Yes for all these alerts (if they come at all) as these sites are comletely trusted. I am attaching the the code which checks for the status code.
`'Takes input url as String and return the status(200 is up ,rest all are down)
Function urlCheck(url As String) As Integer
On Error GoTo error_help
Dim http: Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", url, False
http.Send
If (Not http.Status = 200) Then
urlCheck = http.Status
Else
urlCheck = http.Status
End If
error_help:
'MsgBox "error"
End Function
`
I have already tried Application.DisplayAlerts = False , it doesn't work

Related

Suppressing Window Security Warning Message

I am looking for way to check if files exist in a SharePoint location. I am using a function that performs this action but a message box titled: Windows Security Warning, with the message "This pages is accessing information that is not under its control. This poses a security risk. Do you want to continue?"
Here is the function I am using:
Public Function SP_File_Exists (URLString as String) as Boolean
Dim oHttPRequst as Object
if Len(Trim(URLString)) =0 Then
SP_File_Exists = False
Exit Function
Set oHttpRequest = CreateObject("MSXML2.XMLHTTP.6.0")
With oHttpRequest
.Open "GET", URLString, False
.Send
End With
If oHttpRequest.Status = 200 Or Left(oHttpRequest.Status, 1) = 3 Then ' '300 to accommodate redirects
SPFile_Exists = True
Else
SPFile_Exists = False
End If
End Function
Is there a way to suppress the message? I have tried using DisplayAlerts property and it doesn't work. I am hopeful that someone has conquered this problem.

Get Data using MSXML2.XMLHTTP

i am trying to get data using MSXML2.XMLHTTP
but it didn't work
any ideas?
Sub getdata
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As String
Dim sht As Worksheet
Application.DisplayAlerts = False
Set sht = ActiveSheet
On Error Resume Next
website = "https://shopee.co.id/AFI-EC-Tshirt-Yumia-(LD-90-P-57)-i.10221730.5568491283"
Set request = CreateObject("MSXML2.XMLHTTP")
request.Open "GET", website, False
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
request.send
response = StrConv(request.responseBody, vbUnicode)
html.DocumentElement.innerHTML = response
price = html.querySelector("div.AJyN7v")(0).innerText
Debug.Print price
Application.StatusBar = ""
On Error GoTo 0
Application.DisplayAlerts = True``
End Sub
I have done many ways but still not working ,
hope someone can help me
Pretty much everything on that page requires javascript to load. Javascript doesn't run with xmlhttp request to landing page so price never gets retrieved..
The price is being retrieved dynamically from an additional API call returning json.
If you examine the url you will have the following:
https://shopee.co.id/AFI-EC-Tshirt-Yumia-(LD-90-P-57)-i.10221730.5568491283
The last set of consecutive numbers is the product id i.e. 5568491283.
If you open the network tab of dev tools F12, and press F5 to refresh the web traffic that updates the page, then check on the xhr only traffic, then input your product id into the search box, the first result retrieved is the xhr which is returning the price:
https://shopee.co.id/api/v2/item/get?itemid=5568491283&shopid=10221730
The response is json so you will need a json parser to extract the result (or use regex on string - less preferable)
In the headers sub-tab you can view info about the xhr request made.
Check the terms and conditions to see if scraping allowed and also whether there is an public API for retrieving this data.

Excel VBA get data from web with msxml2.xmlhttp - how do I accept cookies automatically?

need your expertise and help, as i've looked around and couldn't find a solution:
I am uploading information to Excel from a website using the msxml2.xmlhttp method (did it earlier via webquery but it gets stuck after a few iterations plus it is slower). My problem is that now on every iteration, I have a Windows Security warning popping up asking me to accept a cookie from the website. Note that the website doesn't require a login/password. I understood from an earlier post that the msxml2.xmlhttp method strips cookies for security reasons, but I get the same message even if I change the method to winhttp. I also changed the settings in IE to accept all cookies automatically from the website but it didn't help.
My question is, what code do I need to add in order to have the cookies be accepted automatically, as I am looping this code on bulk and can't have it hang waiting for me to accept the cookie manually. Your help will be very much appreciated!!! Below is the code snippet (which I actually found here on Stackoverflow).
Set htm = CreateObject("htmlFile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://finance.yahoo.com/q/ae?s=" & Ticker & "+Analyst+Estimates", False
.send
htm.body.innerHTML = .responseText
End With
Set elemCollection = htm.getElementsByTagName("td")
For Each itm In elemCollection
If itm.className = "yfnc_tabledata1" Then
ActiveCell = itm.innerText
If ActiveCell.Column = 7 Then
ActiveCell.Offset(1, -6).Select
Else
ActiveCell.Offset(0, 1).Select
End If
End If
Next
I had the same problem this week.
After google and trying some ideas, I added two MsgBox statements to my code.
objXMLDoc.Open "GET", strURL, False
objXMLDoc.send
MsgBox "After XMLDoc.send", vbOKOnly, "Test"
objHTMLDoc.body.innerHTML = objXMLDoc.responseText
MsgBox "After .innerHTML assignment", vbOKOnly, "Test"
I found pop-up security warning windows always appear after .innerHTML assignment, i.e., the problem is nothing to do with XMLHttp. It is HTMLDocument, which causes the pop-ups.
I guess objHTMLDoc.body.innerHTML = objXMLDoc.responseText does not just do a simple value assignment. It must also trigged some action according to the contents of the webpage.
I checked the webpage and found some code like this:
YUI().use('node','event','event-mouseenter','substitute','oop','node-focusmanager','node','event','substitute','**cookie**','event-resize','node', 'event', 'querystring-stringify','node','event','node','event','event-custom','event-valuechange','classnamemanager','node', function(Y) {})
Then I changed my code as follows and the pop-up warning windows disappear.
objXMLDoc.Open "GET", strURL, False
objXMLDoc.send
objHTMLDoc.body.innerHTML = Replace(objXMLDoc.responseText, "cookie", "")
Hope this can be helpful if you still have the problem.

vbs script to send data and repeat

Does anyone have sample VBS code that sends a variable, waits response and repeat?
i have so far:
dim input
input = Inputbox ("Enter Var:" ,"Var sender...")
SourceURL = "http://example.com/someFunction.php?var="&input&""
that's it... my other code is not functional...
thanks in advance, hope anyone can help, totally lost in vbs... in windows in general...
Assuming that this is Windows Script Host, you can use the MSXML2 library.
do while true
Dim input, SourceURL
input = Inputbox ("Enter Var:" ,"Var sender...")
SourceURL = "http://www.google.co.uk/search?q=" & input
''// connect and send to server
Dim http: set http = CreateObject("MSXML2.XMLHTTP")
http.open "GET", SourceURL, false
http.send
if http.status = 200 then
''// do something with the return value if necessary
WScript.Echo http.responseText
else
''// problem?
end if
''// pause execution if you don't want to hit the server so often
WScript.Sleep 10
loop
if you're modifying things on the server, you should probably use a POST request instead of a GET request, but this should work if your server side script only accepts GET requests

Check for active internet connection

Wrote a small app that accesses a bunch of search websites and puts the results in a word document, which gets run a few hundred times a day.
It saves individual search results in a number of local folders so the next time those words are searched, it grabs them locally instead of loading the website again.
This works fine - even though it's not quick. People are impressed because until a few weeks ago they did this manually by literally loading up six different search websites, searching, and then copying and pasting the results in a word document.
However, our Office's internet is unreliable, and has been down the last half a day. This has meant about 400 bad searches have been saved in the local folders, and inserted into the final documents.
When a person was searching they could tell if the internet was broken and they would do their searches later. Obviously, though, this app can't tell, and because I'm not using APIs or anything, and because I am limited to using the VBA environment (I'm not even allowed MZ tools), I need to find some way to check that the internet is working before continuing with the program flow, without relying on too many references, and preferably without screenscraping for the phrase "404 Page Not Found".
I'm not very familiar with VB, and VBA is ruining me in so many ways, so there's probably some easy way to do this, which is why I'm asking here.
Appreciate any help.
Obviously, your problem has many levels. You should start by defining "connected to the internet", and go on with developing fallback strategies that include not writing invalid files on failure.
As for the "am I connected" question, you can try tapping into the Win32 API:
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwflags As Long, ByVal dwReserved As Long ) As Long
Public Function GetInternetConnectedState() As Boolean
GetInternetConnectedState = InternetGetConnectedState(0&,0&)
End Function
Though depending on your network setup (proxy/NAT/firewall restrictions etc.), Windows might have a different opinion about this than you.
Trying to GET the pages you are interested in, checking on the return status in the HTTP headers (gateway timeout, 404, whatever you expect to happen when it "doen't work) might also be a way to go.
You could use MSXML library & use XMLHttpRequest class to check for things
e.g.
On Error Resume Next
Dim request As MSXML2.XMLHTTP60
request.Open "http://www.google.com"
request.Send
Msgbox request.Status
The status will give you HTTP Status code of what happened to the request.
You might have to do some more checks, depending on your scenario.
Hope that helps.
Use the following code to check for internet connection
first anable XML v6.0 in your references
Function checkInternetConnection() As Integer
'code to check for internet connection
'by Daniel Isoje
On Error Resume Next
checkInternetConnection = False
Dim objSvrHTTP As ServerXMLHTTP
Dim varProjectID, varCatID, strT As String
Set objSvrHTTP = New ServerXMLHTTP
objSvrHTTP.Open "GET", "http://www.google.com"
objSvrHTTP.setRequestHeader "Accept", "application/xml"
objSvrHTTP.setRequestHeader "Content-Type", "application/xml"
objSvrHTTP.Send strT
If err = 0 Then
checkInternetConnection = True
Else
MsgBox "Internet connection not estableshed: " & err.Description & "", 64, "Additt !"
End If
End Function
Unfortunately, this is a bit of a difficult question to answer for a couple of reasons:
How do you define a non-working internet connection? Do you check for a valid IP address? Do you ping out? How do you know that you have permissions to check these things? How do you know that the computer's firewall/antivirus isn't causing wonky behavior?
Once you've established that the connection is working, what do you do if the connection drops mid-operation?
There are probably ways to do what you want to do, but a lot of "devil's in the details" type things tend to pop up. Do you have any way to check that the saved search is valid? If so, that would probably be the best way to do this.
Building on shakalpesh's answer and the comments to it, there are (at least) two ways to get the web page into Word without parsing the XML returned by the XMLHTTP60 object.
(NB the HTTP status code of 200 indicates that "the request has succeeded" - see here)
write the XMLHTTP60.ResponseText out to a text file and then call Documents.Open on that text file
If (xhr.Status = 200) Then
hOutFile = FreeFile
Open "C:\foo.html" For Output As #hOutFile
Print #hOutFile, xhr.responseText
Close #hOutFile
End If
// ...
Documents.Open "C:\foo.html"
This has the disadvantage that some linked elements may be lost and you'll get a message box when the file opens
check the URL status with the XMLHTTP60 object and then use Documents.Open to open the URL as before:
If (xhr.Status = 200) Then
Documents.Open "http://foo.bar.com/index.html"
End If
There is a slight chance that the XMLHTTP60 request could succeed and the Documents.Open one fail (or vice versa). Hopefully this should be a fairly uncommon event though
I found most answers here and elsewhere confusing or incomplete, so here is how to do it for idiots like me:
'paste this code in at the top of your module (it will not work elsewhere)
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwflags As Long, ByVal dwReserved As Long) As Long
Private Const INTERNET_CONNECTION_MODEM As Long = &H1
Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_PROXY As Long = &H4
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
'paste this code in anywhere
Function IsInternetConnected() As Boolean
Dim L As Long
Dim R As Long
R = InternetGetConnectedState(L, 0&)
If R = 0 Then
IsInternetConnected = False
Else
If R <= 4 Then IsInternetConnected = True Else IsInternetConnected = False
End If
End Function
'your main function/calling function would look something like this
Private Sub btnInternetFunction_Click()
If IsInternetConnected() = True Then
MsgBox ("You are connected to the Internet")
'code to execute Internet-required function here
Else
MsgBox ("You are not connected to the Internet or there is an issue with your Internet connection.")
End If
End Sub
This is what I use. I prefer it because it doesn't require any external references or DLLs.
Public Function IsConnected()
Dim objFS As Object
Dim objShell As Object
Dim objTempFile As Object
Dim strLine As String
Dim strFileName As String
Dim strHostAddress As String
Dim strTempFolder As String
strTempFolder = "C:\PingTemp"
strHostAddress = "8.8.8.8"
IsConnected = True ' Assume success
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
If Dir(strTempFolder, vbDirectory) = "" Then
MkDir strTempFolder
End If
strFileName = strTempFolder & "\" & objFS.GetTempName
If Dir(strFileName) <> "" Then
objFS.DeleteFile (strFileName)
End If
objShell.Run "cmd /c ping " & strHostAddress & " -n 1 -w 1 > " & strFileName, 0, True
Set objTempFile = objFS.OpenTextFile(strFileName, 1)
Do While objTempFile.AtEndOfStream <> True
strLine = objTempFile.Readline
If InStr(1, UCase(strLine), "REQUEST TIMED OUT.") > 0 Or InStr(1, UCase(strLine), "COULD NOT FIND HOST") > 0 Then
IsConnected = False
End If
Loop
objTempFile.Close
objFS.DeleteFile (strFileName)
objFS.DeleteFolder (strTempFolder)
' Remove this after testing. Function will return True or False
MsgBox IsConnected
End Function
I encourted this same problem and after googling a lot, I realized there was a simpler way to do it... It requires the user to enable the Microsoft Internet Explorer Controlers library, but that is all. The idea is that your code navigates to a website (in this case google), and after getting the webpage document (HTML). puts a value in the search box.
Sub Test1()
On Error GoTo no_internet 'Error handler when no internet
Dim IE As New SHDocVw.InternetExplorer
IE.Visible = False 'Not to show the browser when it runs
IE.navigate "www.google.com" 'navigates to google
Do While IE.ReadyState <> READYSTATE_COMPLETE 'loops until it is ready
Loop
'Here It gets the element "q" from the form "f" of the HTML document of the webpage, which is the search box in google.com
'If there is connection, it will run, quit and then go to the msgbox.
'If there is no connection, there will be an error and it will go to the error handler "no_internet" that is declared on top of the code
IE.document.forms("f").elements("q").Value = "test"
IE.Quit
MsgBox "Internet Connection: YES"
Exit Sub
no_internet:
IE.Quit
MsgBox "Internet Connection: NO" ' and here it will know that there is no connection.
End Sub