Download file from url in Excel 2019 (it works on

2020-06-19 07:05发布

I got a code to download a CSV file from a website that requires credentials. I got a code thanks to this website and I could adapted to my needs. My relevant part of code is:

Option Explicit

Private Declare Function URLDownloadToFileA Lib "urlmon" _
    (ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long

Private Function DownloadUrlFile(URL As String, LocalFilename As String) As Boolean
    Dim RetVal As Long
    RetVal = URLDownloadToFileA(0, URL, LocalFilename, 0, 0)
    If RetVal = 0 Then DownloadUrlFile = True
End Function

Sub DESCARGAR_CSV_DATOS()

Dim EstaURL As String
Dim EsteCSV As String

EstaURL = "https://user:token@www.privatewebsite.com/export/targetfile.csv"
EsteCSV = "MyCSV " & Format(Date, "dd-mm-yyyy") & ".csv"

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    DownloadUrlFile EstaURL, _
        ThisWorkbook.Path & "\" & EsteCSV

    DoEvents

    Workbooks.Open ThisWorkbook.Path & "\" & EsteCSV, , True, , , , , , , , , , , True

    'rest is just doing operations and calculations inside workbook

End Sub

Sorry but I cannot provide the real url. Anyways, this code has been working perfectly since September 2019. And it still works perfectly every day.

The computers that execute this code are all of them Windows 7 and Excel 2007 and 64 bits. None of them fail.

But now, this task is going to be outsourced to another office. There, the computers are Excel 2019, Windows 10 and 64 bits.

And the code does not work there. It does not arise any error, but the function DownloadUrlFile does not download any file on Excel 2019 + W10

So to resume, Excel 2007 + Windows 7 works perfectly (tested today). Excel 2019 + Windows 10 does not work (no errors on screen).

Things I've tried to fix it:

  1. I've checked that file urlmon.dll exists in system32 and it does
  2. I've tried declaring the function URLDownloadToFileA using PtrSafe
  3. If I manually type the url in Chrome in the PC with Excel 2019 + W10, the file is downloaded properly, so the URL is ok.

None of this solved my problem. I'm pretty sure the solution it's really easy, because the code works perfectly in Excel 2007, but I can't find what I'm missing here.

I would like to get a code that works in any case, but I would accept also a solution that works only in Excel 2019 and Windows 10 if it's the only way.

Hope somebody can throw some light about this. Thanks in advance.

UPDATE: Tried also the solution in this post but still nothing.

UPDATE 2: Also, tested the code posted here (Excel 2007) with Excel 2010 and it works perfectly.

UPDATE 3: The variable RetVal stores the result of the download. I know some values:

' Returns 0 if success, error code if not.
' Error codes:
' -2146697210 "file not found".
' -2146697211 "domain not found".
' -2147467260 "transfer aborted".

But in my case, it returns -2147221020. What could that be?

UPDATE 4: Well, this is just weird. I've tried same code to download a different file from a public website, and it works in Excel 2019 + W10. I made a new easy code like this:

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As LongPtr, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As LongPtr, _
        ByVal lpfnCB As LongPtr _
      ) As Long
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As Long, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As Long _
      ) As Long
#End If

Sub Descarga()
Dim EstaURL As String
Dim EsteCSV As String

EstaURL = privateone 'can't be shared, sorry
EsteCSV = "CSV Datos " & Format(Date, "dd-mm-yyyy") & ".csv"

    On Error GoTo Errores
    URLDownloadToFile 0, "https://tutorialesexcel.com/wp-content/uploads/2018/10/funciones.xlsm", ThisWorkbook.Path & "\" & EsteCSV, 0, 0
    URLDownloadToFile 0, EstaURL, ThisWorkbook.Path & "\" & EsteCSV, 0, 0
    Exit Sub
Errores:
    'Si es un bucle lo mejor sería no mostrar ningún mensaje
    MsgBox "Not downloaded", vbCritical, "Errores"
End Sub

The line that says URLDownloadToFile 0, "https://tutorialesexcel.com/wp-content/uploads/2018/10/funciones.xlsm", ThisWorkbook.Path & "\" & EsteCSV, 0, works perfect and downloas the file.

The line URLDownloadToFile 0, EstaURL, ThisWorkbook.Path & "\" & EsteCSV, 0, 0does not work.

So tested again exactly same code but on Excel 2007 and both of them work

Why the first download works and the second one does not on Excel 2019 + W10 but both of them work on Excel 2007+W7?

UPDATE 5: The URL is private, because it contains username and password, but it's like this:

https://user:token@www.privatewebsite.com/export/target%20file.csv

Thanks to @Stachu, the URL does not work manually on Internet Explorer on any PC (copy/pasting in the explorer navigation bar, I mean). The URL works perfectly in Google Chrome in all PC.

It's really curious that, manually, the URL on Internet Explorer does not work, but same URL coded with VBA and Executed on Excel2007/2010 works perfectly. Maybe I should change something about the encoding?

UPDATE 6: Still studying all posts by you. The issue here is that I'm just the data guy, the analyst, so plenty of information posted here sounds really hardcore to me.

I've emailed all the info to the IT guys 1 day ago, and still waiting for an answer.

Meanwhile, and based on information here, finally coded something totally different that works on all machines. It works on Windows 7 and 10, and it works on Excel 2007 and 2010 (installed as 32 bits) and Excel 2019 (installed as 64 bits).

I'm adding the code here, so maybe somebody can explain why it works properly, but it looks like the issue was the base64 encoding.

The code I got now is like this (added reference to Microsoft Winhttp Setvices 5.1)

Application.ScreenUpdating = False

Dim whr As WinHttp.WinHttpRequest
Dim oStream As Object
Dim EsteCSV As String
Dim EstaURL As String


EstaURL = "https://user:pass@www.privatewebsite.com/export/target%20file.csv" 
EsteCSV = "CSV Datos" & Format(Date, "dd-mm-yyyy") & ".csv"

'Set whr = CreateObject("WinHttp.WinHttpRequest.5.1")

Set whr = New WinHttp.WinHttpRequest

whr.Open "GET", EstaURL, True
whr.setRequestHeader "Authorization", "Basic " & EncodeBase64("user" & ":" & "password")
whr.send

' Using 'true' above and the call below allows the script to remain responsive.
whr.waitForResponse
DoEvents

Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write whr.responseBody
oStream.SaveToFile ThisWorkbook.Path & "\" & EsteCSV
oStream.Close
DoEvents

Set oStream = Nothing
whr.abort
Set whr = Nothing
'rest of code for operations

Kill ThisWorkbook.Path & "\" & EsteCSV

Application.ScreenUpdating = True

End Sub

Private Function EncodeBase64(text As String) As String
  Dim arrData() As Byte
  arrData = StrConv(text, vbFromUnicode)

  Dim objXML As Object
  Dim objNode As Object

  Set objXML = CreateObject("MSXML2.DOMDocument")
  Set objNode = objXML.createElement("b64")

  objNode.DataType = "bin.base64"
  objNode.nodeTypedValue = arrData
  EncodeBase64 = objNode.text

  Set objNode = Nothing
  Set objXML = Nothing
End Function

标签: excel vba
6条回答
Emotional °昔
2楼-- · 2020-06-19 07:23

Thanks everybody for all your help and answers. Unfortunately, my IT department was not able to tell me what was happening exactly, even with all the links provided here with a lot of useful info.

I'm posting here the code we are using here right now. IT's works perfectly on Excel 2007 32 bit, Excel 2010 32 and 64 bits and Excel 2019 64 bits. It works too on Windows 7 and 10.

To make this code work, you need to add a reference to Microsoft Winhttp Setvices 5.1. Check How to Add an Object Library Reference in VBA in case you don't know how to do this:

Application.ScreenUpdating = False

Dim whr As WinHttp.WinHttpRequest
Dim oStream As Object
Dim EsteCSV As String
Dim EstaURL As String


EstaURL = "https://user:pass@www.privatewebsite.com/export/target%20file.csv" 
EsteCSV = "CSV Datos" & Format(Date, "dd-mm-yyyy") & ".csv"

'Set whr = CreateObject("WinHttp.WinHttpRequest.5.1")

Set whr = New WinHttp.WinHttpRequest

whr.Open "GET", EstaURL, True
whr.setRequestHeader "Authorization", "Basic " & EncodeBase64("user" & ":" & "password")
whr.send

' Using 'true' above and the call below allows the script to remain responsive.
whr.waitForResponse
DoEvents

Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write whr.responseBody
oStream.SaveToFile ThisWorkbook.Path & "\" & EsteCSV
oStream.Close
DoEvents

Set oStream = Nothing
whr.abort
Set whr = Nothing
'rest of code for operations

Kill ThisWorkbook.Path & "\" & EsteCSV

Application.ScreenUpdating = True

End Sub

Private Function EncodeBase64(text As String) As String
  Dim arrData() As Byte
  arrData = StrConv(text, vbFromUnicode)

  Dim objXML As Object
  Dim objNode As Object

  Set objXML = CreateObject("MSXML2.DOMDocument")
  Set objNode = objXML.createElement("b64")

  objNode.DataType = "bin.base64"
  objNode.nodeTypedValue = arrData
  EncodeBase64 = objNode.text

  Set objNode = Nothing
  Set objXML = Nothing
End Function

Thanks again everyone. SO is a great place.

查看更多
做自己的国王
3楼-- · 2020-06-19 07:27

I tried this solution in Excel 2019 / O365 64 bits (version: 1912) / win 10 64 bits

I know you have a working code, but if anybody else needs an alternative, here it is:

Sub DownloadFile()

    Dim evalURL As String
    Dim streamObject As Object
    Dim winHttpRequest As Object
    Set winHttpRequest = CreateObject("Microsoft.XMLHTTP")

    evalURL = "https://fullPathTofile/tst.csv" ' -> Didn't need to add the username at the beginning

    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:\temp\file.csv", 2 ' 1 = no overwrite, 2 = overwrite
        streamObject.Close
    End If

End Sub
查看更多
贪生不怕死
4楼-- · 2020-06-19 07:30

The "simplified" method you used (user+password@url) has had spotty support at best due to its potential of remote abuse. Some browsers no longer even support it.

For example, a HREF link of ...admin:admin@192.168.1.1/cgi-bin/something-else?... is enough to exploit several routers protected only by a "deny remote access" default instead of a reliable password, and there are many of those.

You might be able to overcome this by saving user and password in Internet Explorer, whose libraries are used by Excel, and/or placing the remote site in the "Trusted Sites" group from Internet Options. But this is a stopgap measure too, since the password cache might be erased by accident and security levels might be reset by an update at any time (I had this happen to me more than once).

Here there are other methods discussed. Otherwise, your solution of course works (you might want to add an answer to that effect, and mark it accepted for the next who gets the same problem).

查看更多
成全新的幸福
5楼-- · 2020-06-19 07:34

Sub Code is fine. Check the references in tools menu in vba and make declaration ptrsafe as below

Private Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" _

enter image description here

查看更多
疯言疯语
6楼-- · 2020-06-19 07:45

As for your error, -2147221020 => 0x800401E4 as per VBA Error Codes and Descriptions this error is MK_E_SYNTAX which is 'invalid moniker syntax'.

When it says moniker I guess it means your url and to be honest the web address does not look syntactically correct...

"https://user:token@www.privatewebsite.com/export/targetfile.csv"

I'd have to dig around to see if that truly met the web standard for a url. In the meantime I'd suggest figuring out a different url. It maybe that an upgrade to urlmon.dll now complains about the url whereas the Windows 7 version didn't.

Ok, my bad, actually it looks like you can do such uris, in theory, so I have a uri fragment

first-client:noonewilleverguess@localhost:8080/oauth/token taken from OAuth2 Boot

Ok, so it is valid, re top of page 17 rfc3986.

authority = [ userinfo "@" ] host [ ":" port ]

Looks like you'll have to drop into Windows API calls to set username and password. So here is sample code

Option Explicit

'* with thanks to http://www.holmessoft.co.uk/homepage/WininetVB.htm

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
    ByVal lpszAgent As String, _
    ByVal dwAccessType As Long, _
    ByVal lpszProxyName As String, _
    ByVal lpszProxyBypass As String, _
    ByVal dwFlags As Long) As Long


Private Enum InternetOpenAccessTypes
    INTERNET_OPEN_TYPE_PRECONFIG = 0 'Retrieves the proxy or direct configuration from the registry.
    INTERNET_OPEN_TYPE_DIRECT = 1 'Resolves all host names locally.
    INTERNET_OPEN_TYPE_PROXY = 3 'Passes requests to the proxy unless a proxy bypass list is supplied and the name to be resolved bypasses the proxy. In this case, the function uses INTERNET_OPEN_TYPE_DIRECT.
    INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 'Retrieves the proxy or direct configuration from the registry and prevents the use of a startup Microsoft JScript or Internet Setup (INS) file.
End Enum


Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _
    ByVal hInternetSession As Long, _
    ByVal lpszServerName As String, _
    ByVal nServerPort As Integer, _
    ByVal lpszUsername As String, _
    ByVal lpszPassword As String, _
    ByVal dwService As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

Private Const INTERNET_SERVICE_HTTP = 3

Private Const INTERNET_FLAG_NO_COOKIES = &H80000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" ( _
    ByVal hHttpSession As Long, _
    ByVal lpszVerb As String, _
    ByVal lpszObjectName As String, _
    ByVal lpszVersion As String, _
    ByVal lpszReferer As String, _
    ByVal lpszAcceptTypes As String, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" ( _
    ByVal hHttpRequest As Long, _
    ByVal lpszHeaders As String, _
    ByVal dwHeadersLength As Long, _
    ByVal lpOptional As String, _
    ByVal dwOptionalLength As Long) As Boolean

Private Declare Function InternetReadFile Lib "wininet.dll" ( _
    ByVal hFile As Long, _
    ByVal lpBuffer As String, _
    ByVal dwNumberOfBytesToRead As Long, _
    ByRef lpNumberOfBytesRead As Long) As Boolean

Private Sub Test()
    Dim hInternet As Long
    hInternet = InternetOpen("Mozilla", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    If hInternet = 0 Then
        Debug.Print "InternetOpen failed"
        GoTo SingleExit
    End If

    Dim sUSERNAME As String
    sUSERNAME = "foo"

    Dim sPASSWORD As String
    sPASSWORD = "bar"


    Dim hConnect As Long
    hConnect = InternetConnect(hInternet, "www.microsoft.com", 80, sUSERNAME, sPASSWORD, INTERNET_SERVICE_HTTP, 0, 0)
    If hConnect = 0 Then
        Debug.Print "InternetConnect failed"
        GoTo SingleExit
    End If

    Dim lFlags As Long
    Dim hRequest As Long

    lFlags = INTERNET_FLAG_NO_COOKIES
    lFlags = lFlags Or INTERNET_FLAG_NO_CACHE_WRITE

    hRequest = HttpOpenRequest(hConnect, "GET", "www.microsoft.com", "HTTP/1.0", vbNullString, vbNullString, lFlags, 0)

    Dim bRes As Boolean
    bRes = HttpSendRequest(hRequest, vbNullString, 0, vbNullString, 0)

    Dim strFile As String
    strFile = "downloadedfile.txt"

    Dim strBuffer As String * 1
    Dim strDir As String
    strDir = Dir(ThisWorkbook.Path & "\" & strFile)
    If Len(strDir) > 0 Then
        Kill ThisWorkbook.Path & "\" & strFile
    End If

    Dim iFile As Long
    iFile = FreeFile()
    Open ThisWorkbook.Path & "\" & strFile For Binary Access Write As iFile

    Do
        Dim lBytesRead As Long
        bRes = InternetReadFile(hRequest, strBuffer, Len(strBuffer), lBytesRead)
        If lBytesRead > 0 Then
            Put iFile, , strBuffer
        End If
    Loop While lBytesRead > 0

    Debug.Print "finished"
SingleExit:


End Sub

UPDATE: Congratulations on your solution for which you invite an explanation, perhaps see this MSDN Forum where the discourse outlines the different technology stacks. If I browse the C++ header file urlmon.h then URLDownloadToFile looks like its based on WinInet. So switching to WinHTTP is a smart move to a more server based stack.
Also, on the same stack logic, I believe you could have used MSXML2.ServerXMLHTTP see this VBScript newsgroup archive

查看更多
我只想做你的唯一
7楼-- · 2020-06-19 07:48

The computers that execute this code are all of them Windows 7 and Excel 2007 and 64 bits. None of them fail.

But now, this task is going to be outsourced to another office. There, the computers are Excel 2019, Windows 10 and 64 bits.

And the code does not work there. It does not arise any error, but the function DownloadUrlFile does not download any file on Excel 2019 + W10

I'm guessing it is not working in another office.

This will only happen if the URL is private and the IPs are not whitelisted. You can check with your networking team for the same whether they have whitelisted the IPs for that URL.

The line that says URLDownloadToFile 0, "https://tutorialesexcel.com/wp-content/uploads/2018/10/funciones.xlsm", ThisWorkbook.Path & "\" & EsteCSV, 0, works perfect and downloas the file.

The line URLDownloadToFile 0, EstaURL, ThisWorkbook.Path & "\" & EsteCSV, 0, 0does not work.

So tested again exactly same code but on Excel 2007 and both of them work

Why the first download works and the second one does not on Excel 2019 + W10 but both of them work on Excel 2007+W7?

Also, It makes no sense that the same code is working perfectly fine for the public URL and not for the private URL except there is an IP restriction.

查看更多
登录 后发表回答