I just want to check if a file already exist in a sharepoint. I used a Boolean Function that worked perfectly at the begining but since a short periode it doesn't work anymore!!
this is what i wrote:
Public Function checkFile(URLStr As String) As Boolean
Dim oHttpRequest As Object
If Len(Trim(URLStr)) = 0 Then checkFile = Empty: Exit Function
Set oHttpRequest = CreateObject("MSXML2.XMLHTTP.6.0")
With oHttpRequest
.Open "GET", URLStr, False ', [UserName], [Password]
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.send
End With
If oHttpRequest.Status = 200 Then
checkFile = True
Else
checkFile = False
End If
Set oHttpRequest = Nothing
End Function
Here the mistake is at the point. .send
I don't understand why and i don't find another solution to check if a file exist since the file is in a sharepoint site.
Related
I've written a script in vba to get only the links of different properties under the title Single Family Homes from the right sided area of a webpage. When I run my script, I get nothing, no error either. The content I wish to grab are static and available within page source, so XMLHttpRequestshould do the trick.
Although it seems the selectors I've defined within my script is errorless, I can't still fetch the links of different properties.
Webpage address
I've written:
Sub GetLinks()
Const link$ = "https://www.zillow.com/homes/for_sale/33125/house_type/12_zm/0_mmm/"
Dim oHttp As New XMLHTTP60, Html As New HTMLDocument
Dim I&
With oHttp
.Open "GET", link, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
Html.body.innerHTML = .responseText
With Html.querySelectorAll("article > a.list-card-info")
For I = 0 To .Length - 1
Sheet1.Range("A1").Offset(I, 0) = .item(I).getAttribute("href")
Next I
End With
End With
End Sub
Expected links are like:
https://www.zillow.com/homedetails/3446-NW-15th-St-Miami-FL-33125/43822210_zpid/
https://www.zillow.com/homedetails/1877-NW-22nd-Ave-Miami-FL-33125/43823838_zpid/
https://www.zillow.com/homedetails/1605-NW-8th-Ter-Miami-FL-33125/43825765_zpid/
How can I get all the links of different properties from it's landing page from the link above?
Use the class of the child alone. Note there are a number of other things I would like to change about the code but know you like to keep your structure/style.
Sub GetLinks()
Const link$ = "https://www.zillow.com/homes/for_sale/33125/house_type/12_zm/0_mmm/"
Dim oHttp As New XMLHTTP60, Html As New HTMLDocument
Dim I&
With oHttp
.Open "GET", link, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
Html.body.innerHTML = .responseText
With Html.querySelectorAll(".list-card-info")
For I = 0 To .Length - 1
Sheet1.Range("A1").Offset(I, 0) = .item(I).getAttribute("href")
Next I
End With
End With
End Sub
Some of the changes I might make:
Private Sub GetLinks()
Const LINK As String = "https://www.zillow.com/homes/for_sale/33125/house_type/12_zm/0_mmm/"
Dim http As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument
Dim i As Long, links As Object
Set http = New MSXML2.XMLHTTP60: Set html = New MSHTML.HTMLDocument
With http
.Open "GET", LINK, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
html.body.innerHTML = .responseText
End With
Set links = html.querySelectorAll(".list-card-info")
With ThisWorkbook.Worksheets("Sheet1")
For i = 0 To links.Length - 1
.Cells(i + 1, 1) = links.item(i).href
Next i
End With
End Sub
Checking some URLs with
Function SiteStatus(ByVal URL As String, SiteStatusText As String) As Long
Dim oHttp As New WinHttp.WinHttpRequest
oHttp.Option(WinHttpRequestOption_EnableRedirects) = False
oHttp.Open "GET", URL, False
oHttp.Send
SiteStatus = oHttp.Status
SiteStatusText = oHttp.StatusText
End Function
generally works fine. Only a few URLs throw a VBA error -2147012744. The Server is giving an invalid or unknown response.
Some URLs in real work, I can open them with SHDocVw library, and some not, - that makes no difference.
for instance:
http: //s2.excoboard.com/Courthouse_Steps_Mavens/150601/1831324
or
http: //www.geld-und-leben.com/anleitung/
or
http: //globalnews.ca/news/3025046/justin-timberlakes-illegal-voting-booth-selfie-is-under-review/
I wanna check the status of these sites although.
How?
What's the point?
i know that this is old, but here is some VBA code that works.
some of the values for oHttp.Option came from http://www.808.dk/?code-simplewinhttprequest
Sub test()
' add reference to Microsoft WinHTTP Services
Dim URL As String
URL = "http://globalnews.ca/news/3025046/justin-timberlakes-illegal-voting-booth-selfie-is-under-review"
Dim oHttp As WinHttpRequest
Set oHttp = New WinHttpRequest
oHttp.Open "GET", URL, False
oHttp.Option(WinHttpRequestOption_UserAgentString) = "http_requester/0.1"
oHttp.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300 ' ignore all err, 0: accept no err
oHttp.Option(WinHttpRequestOption_EnableRedirects) = True
oHttp.Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = True
oHttp.send
Do While True
DoEvents
If oHttp.Status Then Exit Do
Loop
Debug.Print oHttp.Status
End Sub
I'm trying to add a label to an existing issue in JIRA using the JIRA REST API via VBA. I can successfully login, get the session id/cookie, find the issue, and add a comment to the issue, but when I try to add a label I receive the following error message in Excel
However, the funny thing is the label is actually added
Before macro:
After macro:
I just can't explain or figure out what's going on. I've scoured the Internet (particularly the Atlassian forums) and have come across pages with examples that suggest I'm sending this request properly, but I still receive this Run-time error. Among many things here are a few things I've read/do to try and figure this out
I've done a GET on the issue's /editmeta to get the details for the labels field, which produced this
labels":{
"required":false,
"schema":{
"type":"array",
"items":"string",
"system":"labels"
},
"name":"Labels",
"autoCompleteUrl":"http://jira.company.local:8080/rest/api/1.0/labels/suggest?query=",
"operations":[
"add",
"set",
"remove"
]
}
So, according to that I should be able to use the "add" verb to add the label
The method I'm using (found at the bottom of this question) was adapted from user Patrick Patrick's comments from this thread
I've read the documentation on editing data from here
Learned that I should be using PUT instead of POST from here
Read specifically about how to update labels and followed the syntax from here, then tried the new method described in the response here
Finally, I found a bundle of bugs all related to this sort of issue floating around the Atlassian community. Branching out from here
So, that's where I'm at. My Question is simply this:
How can I add the label without receiving the Run-time error every time? It seems a bit pointless if my macro stops every time it adds one label to one issue
Below are the appropriate pieces of code that I am using.
JIRA Module:
Option Explicit
Sub JIRA()
Dim ASNumber As String, Supplier As String, IssueLink As String
Dim myJIRA As New clsJIRARest
With myJIRA
.UserName = "******"
.Password = "******"
.URL = "http://jira.company.local:8080"
If .Login = False Then Exit Sub
.GetLastSummary
IssueLink = .GetIssueLink '<-works fine
ASNumber = .GetASNumber '<-works fine
Supplier = .GetSupplierName '<-works fine
.PostExportComment '<-Throws run-time error 'Operation aborted'
.Logout
End With
End Sub
Appropriate parts of clsJIRARest Class Module:
Public Function Login() As Boolean
Login = False
With JiraAuth
.Open "POST", sURL & "/rest/auth/1/session", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json"
.send " {""username"" : """ & sJIRAUserID & """, ""password"" : """ & sJIRAPass & """}"" '*** HTTP-Request senden"
sErg = .responseText
If .Status = "200" Then
sCookie = "JSESSIONID=" & Mid(sErg, 42, 32) & "; Path=/" & sPfad
Login = True
End If
End With
End Function
Public Function GetLastSummary()
Dim myRegEx As Object: Set myRegEx = CreateObject("vbscript.regexp")
myRegEx.Global = True
myRegEx.Pattern = "as\/([0-9]{4,5}).+?(?=\-)" '<-Working
With JiraService
.Open "GET", sURL & "/rest/api/2/search?jql=assignee=mhill+order+by+lastViewed&now&maxResults=5", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "Set-Cookie", sCookie '*** see Create a "Cookie"
.send
Set sRestAntwort = myRegEx.Execute(.responseText)
Sup = sRestAntwort(0)
ANum = sRestAntwort(0).Submatches(0)
myRegEx.Pattern = "self"":""(.+?(?=""))"
myRegEx.Global = False
Set sRestAntwort = myRegEx.Execute(.responseText)
sIssueLink = sRestAntwort(0).Submatches(0)
End With
End Function
'The comment posts fine below, but the label is what causes the error
Public Function PostExportComment() As Boolean
With JiraService
.Open "POST", sIssueLink & "/comment", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "Set-Cookie", sCookie '*** see Create a "Cookie"
Dim sExportComment As String: sExportComment = "Full Export Requested - Awaiting Download Email"
.send " {""body"" : """ & sExportComment & """}"" '*** HTTP-Request senden"
'
' PostExportComment = IIf(.Status = "201", True, False)
.Open "PUT", sIssueLink, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "Set-Cookie", sCookie '*** see Create a "Cookie"
Dim sExportingLabel As String: sExportingLabel = "Exporting"
'===============Errors on next line==================
.send " { ""update"": { ""labels"": [{""add"": """ & sExportingLabel & """}] } }"" '*** HTTP-Request senden" '(See below photo for error message)
Debug.Print .Status & "|" & .statusText
End With
End Function
It seems they're giving you a specific error code for this. That's great, because you can ignore that one and still handle other possible errors - and if that error number isn't specific to the "PostExportComment" action, then make yourself a local variable to track where the error is happening:
On Error GoTo ErrHandler
'...
currentStep = "PostExportComment"
.PostExportComment '<-Throws run-time error 'Operation aborted'
currentStep = "Logout"
.Logout
End With
CleanExit:
'clean up here
Exit Sub
ErrHandler:
'"Operation aborted" error is a false positive, see https://jira.atlassian.com/browse/JRA-27929
If currentStep = "PostExportComment" And Err.Number = -2147467260 Then
Resume Next
Else
'handle other possible runtime errors here
Resume CleanExit
End If
...or better, wrap the 3rd-party API in a class module and handle that error neatly in your own wrapper for PostExportComment:
Private wrapped As My3rdPartyThing
Public Enum MeaningfulError
ERR_FoobarNotInitialized = vbObjectError + 42
ERR_WrongCredentials
ERR_Whatever
End Enum
Private Sub Class_Initialize()
Set wrapped = New My3rdPartyThing
End Sub
Private Sub Class_Terminate()
Set wrapped = Nothing
End Sub
'wraps the "GetFoo" API method
Public Function GetFoo(ByVal bar As Long) As Something
On Error GoTo ErrHandler
Set GetFoo = wrapped.GetFoo(bar)
Exit Function
ErrHandler:
If Err.Number = 12345 Then
Err.Raise ERR_FoobarNotInitialized
Else
Err.Raise ERR_Whatever
End If
End Sub
I am using the below code to retrieve some data from websites.
Public Function giveMeValue(ByVal link As String) As String
Set htm = CreateObject("htmlFile")
With CreateObject("msxml2.xmlhttp")
.Open "POST", link, False
.send
htm.body.innerhtml = .responsetext
End With
With htm.getelementbyid("JS_topStoreCount")
giveMeValue = .innerText
End With
htm.Close
Set htm = Nothing
End Function
Sometimes the element with ID "JS_topStoreCount" doesn't exist and the function returns #VALUE!. How do I modify this function so that errors are returned as 0 and are highlighted in red?
I couldn't see the reason for the Do Loop so I have removed it, I've added an if statement to check if the html element is nothing before assigning it to the return value.
Public Function giveMeValue(ByVal link As String) As String
Set htm = CreateObject("htmlFile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", link, False
.send
htm.body.innerhtml = .responsetext
End With
If Not htm.getelementbyId("JS_topStoreCount") Is Nothing Then
giveMeValue = htm.getelementbyId("JS_topStoreCount").innerText
Else
giveMeValue = "0"
End If
htm.Close
Set htm = Nothing
End Function
I have a spreadsheet that has hundreds of links that point to a server (with authentication) that can be accessed via the web. I've been searching for a solution to a Link Checker in a spreadsheet that would tell me which links are broken and which are ok. By broken I mean that the website does not get called up at all.
There are various solutions I have found around the web, none of which work for me. I'm boggled by this...
One example that I've tried to use and figure out is re-posted below.
As I've stepped through the code, I have come to realize that the oHTTP.send request brings back "Nothing". It does so for all links in the spreadsheet, regardless of whether the link works, or not.
Public Function CheckHyperlink(ByVal strUrl As String) As Boolean
Dim oHttp As New MSXML2.XMLHTTP30
On Error GoTo ErrorHandler
oHttp.Open "HEAD", strUrl, False
oHttp.send
If Not oHttp.Status = 200 Then CheckHyperlink = False Else CheckHyperlink = True
Exit Function
ErrorHandler:
CheckHyperlink = False
End Function
Any suggestions as to what might be wrong, or right, is highly appreciated!
A couple of possible causes..
Do you mean oHttp.Open "GET", strUrl, False instead of oHttp.Open "HEAD", strUrl, False ?
Perhaps MSXML2.XMLHTTP30 is not available? You can declare an instance of MSXML2.XMLHTTPX as either early bound or late bound which may impact which version you want to use vs what is available (example http://word.mvps.org/FAQs/InterDev/EarlyvsLateBinding.htm)
eg
Option Explicit
'Dim oHTTPEB As New XMLHTTP30 'For early binding enable reference Microsoft XML, v3.0
Dim oHTTPEB As New XMLHTTP60 'For early binding enable reference Microsoft XML, v6.0
Sub Test()
Dim chk1 As Boolean
Dim chk2 As Boolean
chk1 = CheckHyperlinkLB("http://stackoverflow.com/questions/11647297/xmlhttp-send-request-brings-back-nothing")
chk2 = CheckHyperlinkEB("http://stackoverflow.com/questions/11647297/xmlhttp-send-request-brings-back-nothing")
End Sub
Public Function CheckHyperlinkLB(ByVal strUrl As String) As Boolean
Dim oHTTPLB As Object
'late bound declaration of MSXML2.XMLHTTP30
Set oHTTPLB = CreateObject("Msxml2.XMLHTTP.3.0")
On Error GoTo ErrorHandler
oHTTPLB.Open "GET", strUrl, False
oHTTPLB.send
If Not oHTTPLB.Status = 200 Then CheckHyperlinkLB = False Else CheckHyperlinkLB = True
Set oHTTPLB = Nothing
Exit Function
ErrorHandler:
Set oHTTPLB = Nothing
CheckHyperlinkLB = False
End Function
Public Function CheckHyperlinkEB(ByVal strUrl As String) As Boolean
'early bound declaration of MSXML2.XMLHTTP60
On Error GoTo ErrorHandler
oHTTPEB.Open "GET", strUrl, False
oHTTPEB.send
If Not oHTTPEB.Status = 200 Then CheckHyperlinkEB = False Else CheckHyperlinkEB = True
Set oHTTPEB = Nothing
Exit Function
ErrorHandler:
Set oHTTPEB = Nothing
CheckHyperlinkEB = False
End Function
EDIT:
I tested the OP's link by opening in a browser which I've now discovered redirects to the login page instead so it's a different link I was testing. It's probably failing because the oHttp object has not been set to allow redirects. I know it's possible to set redirects for WinHttp.WinHttpRequest.5.1 using the code below. I would need to investigate if this also works for MSXML2.XMLHTTP30 though.
Option Explicit
Sub Test()
Dim chk1 As Boolean
chk1 = CheckHyperlink("http://portal.emilfrey.ch/portal/page/portal/toyota/30_after_sales/20_ersatzteile%20und%20zubeh%C3%B6r/10_zubeh%C3%B6r/10_produktbezogene%20informationen/10_aussen/10_felgen/10_asa-pr%C3%BCfberichte/iq/tab1357333/iq%20016660.pdf")
End Sub
Public Function CheckHyperlink(ByVal strUrl As String) As Boolean
Dim GetHeader As String
Const WinHttpRequestOption_EnableRedirects = 6
Dim oHttp As Object
Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error GoTo ErrorHandler
oHttp.Option(WinHttpRequestOption_EnableRedirects) = True
oHttp.Open "HEAD", strUrl, False
oHttp.send
If Not oHttp.Status = 200 Then
CheckHyperlink = False
Else
GetHeader = oHttp.getAllResponseHeaders()
CheckHyperlink = True
End If
Exit Function
ErrorHandler:
CheckHyperlink = False
End Function
EDIT2:
MSXML2.XMLHTTP does allow redirects (although I believe MSXML2.ServerXMLHTTP doesn't). The redirects are allowed/disallowed depending upon whether the redirect is cross-domain, cross-port etc (see details here http://msdn.microsoft.com/en-us/library/ms537505(v=vs.85).aspx)
Since the redirect to the login page is cross-domain then IE zone policy is implemented. Open IE/Tools/Internet Options/Security/Custom Level and change 'Access data sources across domains' to ENABLED
The original OP's code will now redirect properly.