I'm trying to download a xlsx file from a password protected website to use in PBI.
On PBI I already tried to use Power Query and the Web Connector. I also tried using Power Automate (online version with HTTP connector, since my desktop version doesn't run on background).
And finally I'm using VBA. But all of them returns a file with the website HTML code, instead of the data which should be in the xlsx.
The code from the last try with VBA (which I found here is bellow (with a generic website URL)):
Sub DownloadFile()
Dim evalURL As String
Dim streamObject As Object
Dim winHttpRequest As Object
Set winHttpRequest = CreateObject("Microsoft.XMLHTTP")
evalURL = "https://generic_website.com/Excel_file.xslx" '
winHttpRequest.Open "GET", evalURL, False, "username", "password"
winHttpRequest.send
If winHttpRequest.Status = 200 Then
Set streamObject = CreateObject("ADODB.Stream")
streamObject.Open
streamObject.Type = 1
streamObject.Write winHttpRequest.responseBody
streamObject.SaveToFile "C:\Users\MyUser\Downloads\Excel_file.xslx", 2 ' 1 = no overwrite, 2 = overwrite
streamObject.Close
End If
End Sub
If I log into the website and open the URL directly in a browser, it downloads the .xlsx file.
Is there any way to do that? I have no idea what's happening, since the same code worked to other people.
UPDATE:
I tried the VBA code bellow, and get the results you can see in the image here.
Sub Login()
Dim response As String
With CreateObject("Microsoft.XMLHTTP")
.Open "GET", "https://generic_website.com/Excel_file.xslx", False, "username", "password"
.send
response = .responseText
End With
MsgBox response
End Sub
I do not know if this works as I cant login, and dont know the file. hopefully it can point you in the right direction.
' VBA Editor->Tools->References
' find and select the following
' Microsoft WinHTTP Services,version 5.1
' Microsoft HTML Object Library
Sub GetFile()
Dim URL As String: URL = "your url"
Dim File As String: File = "your url/file.xslx"
Dim Email As String: Email = "your#address.com"
Dim Password As String: Password = "Your Password"
Dim Cookie As String
Dim Token As String
Dim Message As String
Dim HTML As HTMLDocument: Set HTML = New HTMLDocument
Dim HTTP As WinHttpRequest: Set HTTP = New WinHttpRequest
' you potentially need the csrf_token to post the login form.
' so we get the token, and any cookies sent
HTTP.Open "GET", URL, True
HTTP.Send
HTTP.WaitForResponse
HTML.body.innerHTML = HTTP.ResponseText
Cookie = HTTP.GetResponseHeader("Set-Cookie")
Token = HTML.getElementsByName("csrf_token")(0).Value
Message = "csrf_token=" & Token & "&email=" & URLEncode(Email) & "&senha=" & URLEncode(Password)
HTTP.Open "POST", URL, True
HTTP.SetRequestHeader "Content-type", "application/x-www-form-urlencoded"
HTTP.SetRequestHeader "Cookie", Cookie
HTTP.Send Message
HTTP.WaitForResponse
Cookie = HTTP.GetResponseHeader("Set-Cookie")
' i dont have credentials so dont know what happens after this point and cannot test any further
HTTP.Open "GET", File, True
HTTP.SetRequestHeader "Cookie", Cookie
HTTP.Send
HTTP.WaitForResponse
msgbox HTTP.responseText
' if the runtime error still occurs then not sure what to do
' however,
' if the above message box looks like HTML, it didnt work.
' if it doesn't, it MIGHT have worked, you just need to
' figure out how to save the data to a file
'Dim FileNumber As Integer: FileNumber = FreeFile()
'Open "C:\destination.xslx" For Binary Access Write As #FileNumber
'Put #FileNumber, 1, HTTP.ResponseBody
'Close #FileNumber
End Sub
'https://stackoverflow.com/a/218199/212869
Public Function URLEncode(StringVal As String) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = "+"
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
I am looking to parse a 'WinHttpRequest' response in Excel VBA to pull a specific line from the HTML response. Here is the code for the HTTP request.
Function getSetName(ByVal setNUMBER As String) As String
Dim oRequest As Object
Dim xmlResponse As String
Dim setDescription As String
Dim setName As String
Set oRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
oRequest.Open "GET", "https://brickset.com/sets/75192" '& setNUMBER
oRequest.Send
xmlResponse = oRequest.ResponseText
'parse xml response here
getSetName = setName
End Function
I am looking to parse only the line with the HTML tag 'meta name=""description""' to a string which I will later pull information from.
Any help or direction on how to parse this single line would be appreciated.
Try
Sub Test_GetSetName()
Debug.Print GetSetName("75192")
End Sub
Function GetSetName(ByVal SetNUMBER As String) As String
Dim html As New MSHTML.HTMLDocument
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", "https://brickset.com/sets/" & SetNUMBER, False
.send
html.body.innerHTML = .responseText
End With
GetSetName = html.querySelector("[name='description']").Content
End Function
The goal is to have a sheet in excel that contains fields and a button. The click on button will create url from the fields and create a HTTP GET request that returns an image in raw data. This image then should be shown in the current sheet.
This is what i have already done:
Sub GetQrCode()
Dim hReq As Object
Dim ws As Worksheet
Set ws = Sheet1
Dim strUrl As String
strUrl = "https://www.profit365.eu/services/API/QR/PayBySquare.png?IBAN=SK2311000000001234567890&BIC=TATRSKBX&Currency=EUR&Amount=123.40&DueDate=41763&VS=1234568&SS=&CS=&size=256"
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", strUrl, False
.Send
End With
Dim resp As String
resp = hReq.responseBody
End Sub
Now should come the code that shows the resp (raw image).
Is this possible? Has anyone done something similar?
Thank you for the responses
Request your help to solve the below issue,I am struck for two days,
vba run time error '- 2146697208 (800c0008 )': The download of the specified resource has failed
This is my code for your reference:
Sub telebot15status155555()
'Program Excel Messeger
' Purpose : Send Message to Telegram
' Author : John Eswin Nizar
' Date : 09 October 2017
Dim objRequest As Object
Dim strChatId As String
Dim strMessage1 As String
Dim strMessage2 As String
Dim strPostData As String
Dim strResponse As String
strChatId = "#messstatus"
strMessage1 = ""
strMessage2 = Now()
'strMessage = "hallo"
strPostData = "chat_id=" & strChatId & "&text=" & strMessage1 & strMessage2
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/sendMessage?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
GetSessionId = .responseText
MsgBox GetSessionId
End With
End Sub
My advice here is to perform this API call in Chrome with DevTools open. Or access the page, where this happens, and find the Request on the 'Network' tab. Then look at the headers.
debug.print strPostData is returning:
chat_id=#messstatus&text=2/7/2020 9:40:23 AM
That format does not look correct for an API that is form-urlencoded. You need to see what the website is actually sending and receiving in the DevTools in order to replicate it.
IOW, The resource isn't found because the API is incorrectly formatted. From the base api, it looks like its actually a QueryString too because it ends with ? which might mean you have to url-encode format the POST Data into the QueryString for the main HTTP request. Have a look here: Pass Parameters in VBA HTTP Post Request
I want to build a simple spread sheet that make use of latest stock quotes from Yahoo, I tried a few samples from the web, but all failed with this error: "A connection with the server could not be established". Any idea?
Sub getQuotes2()
Dim URL As String
URL = "http://finance.yahoo.com/d/quotes.csv?s=^GSPC&f=l1"
MsgBox URL
Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")
Http.Open "GET", URL, False
Http.send
Dim Resp As String: Resp = Http.responseText
MsgBox Resp
End Sub