Response to download Web URL files to Hard drive and path

rmplant

New Member
Joined
Sep 7, 2022
Messages
6
Office Version
  1. 2011
Platform
  1. Windows
  2. MacOS
Dan,
UPPER case is for emphasis. I am not yelling. Thanks.

I downloaded your posting and tried it. First of all thanks. BUT it did NOT work for me regarding the
DownloadFile DocumentURL, "D:\TEMP\SaveDocumentHere.Doc" substituting my drive:\path\file name and when using a variable such as DestinationFile.

For the Function I copied it and kept getting a Compile Error for (FileExpress) as variable NOT defined. I then inserted right above that line a Dim statement and it now runs through my loop to try and download some 177 files BUT NO FILES are copied.

Here is my coding: YOUR Function first in a separate Module as listed.

VBA Code:
Option Explicit
#If VBA7 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

Public Function DownloadFile(ByVal URL As String, ByVal DestinationFile As String) As Boolean
    ' If the API returns ERROR_SUCCESS (0), DownloadFile returns True.
   
    Dim Error_Success As Integer  ' My addition which averts the error message.
   
    DownloadFile = (URLDownloadToFile(0&, URL, DestinationFile, &H10, 0&) = CLng(Error_Success))
End Function

and here is my FULL coding. The files I am trying to download are about 177 files from the United States Coast Guard on Sample Exams they post each year for merchant mariners to sit for their credential exams. NOT ONE is copied and saved on my hard drive in Drive C: or on my Drive Z:. I am using a MAC BOOK PRO running Parallels with Windows 11 on a Virtual Machine.

VBA Code:
Sub Download_NMC_And_Copy()

    Dim DocumentURL As String
    Dim DestinationFile As String
    Dim myfile As String
    Dim imax, icount As Integer
    Dim Error_Success As Integer
    Dim myURL As String

    ' files to Download from NMC for Deck

    imax = 178     ' In Column B, starting at Row 2, I have the 178 file names listed that I need to download
    icount = 2      ' Because it is Row 2

    Application.ScreenUpdating = True

    Do While icount <= imax
        myfile = Range("B" & icount)
        Range("B" & icount).Select        ' The URL for the NMC website where the files are stored on the USCG computer is correct.
                                                           ' I can MANUALLY open the files and then SAVE AS to my hard drive but that takes a lot of time and is a pain.
        DocumentURL = "[URL]https://www.dco.uscg.mil/Portals/9/NMC/pdfs/examinations/[/URL]" & myfile    '  "q100_ror_inland-international.pdf"     is my FIRST file on the NMC website which you might want to replace for "myfile".
        DestinationFile = "C:/NMC/2022/" & myfile
        DownloadFile DocumentURL, DestinationFile
        icount = icount + 1
    Loop

End Sub


NOW my program previously use to work BUT a NEWER version of Visual Basic was installed and now many of my macros are giving me problems. This one is a major problem. So far I can fix the others I have encountered.

THANK YOU very much in advance.

rmplant
 
Last edited by a moderator:

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Hi. It's a minor miracle that I saw your post! In future, you're probably better off tagging my user handle in the post so it comes up on my notifications.

I'm sorry that you're having difficulty running the code. I'm not sure from which thread you took it from, but I'm familiar with the URLDownloadToFile API. So I tried the code you posted above and, even copied your spreadsheet layout and put the filename in cell B2, and created a folder in my C drive along the lines of yours. The code worked for me. In fact I couldn't recreate the error you're experiencing.

At first I skimmed your post, but now I've read it properly and a few things are jumping out at me now:
  • "I am using a MAC BOOK PRO running Parallels with Windows 11 on a Virtual Machine"
  • "NOW my program previously use to work BUT a NEWER version of Visual Basic was installed and now many of my macros are giving me problems."
I have absolutely no experience whatsoever with Macs, but I assume that your point about running Parallels with Windows 11 on a Virtual Machine means that you have access to the Windows Win32 APIs (like URLDownloadToFile)? Probably of more relevance is the second point - what version of Excel are you now running? Is there any similarities between the problematic macros? One problem that a lot of people experience when 'upgrading' to a newer version of Excel is that when they go from 32bit to 64bit... a lo behold all of their macros start to fail. I was also in that situation a few years back. The problem will occur with APIs, which you can identify with the code at the top of the module containing lines like:
VBA Code:
Private Declare Function
or
Declare PtrSafe Sub
The code above is meant to address that problem, but I'm wondering if the Mac element adds another level of difficulty... I'll ask around. In the meantime, please let me know the version of Excel you were using and are now using, and please give some thought to my question re: similarities. Thank you.
 
Upvote 0
I was so fixated with the error you were getting, that it didn't even occur to me to suggest an alternative - my apologies.

Assuming that you have access to COM objects - and it's not entirely clear that you will do - you might try replacing the above DownloadFile function with the following:

VBA Code:
Sub DownloadFile(ByVal SourceURL As String, ByVal Destination As String)

    Dim HTTPS           As Object
    Dim TargetFile      As Object
    Set HTTPS = CreateObject("WinHttp.WinHttpRequest.5.1")
    On Error GoTo ErrHandler
    
    HTTPS.Open "GET", SourceURL, False
    HTTPS.send

    If HTTPS.Status = 200 Then
       Set TargetFile = CreateObject("ADODB.Stream")
       DoEvents
       With TargetFile
           .Type = 1 ' Early-binding constant = adTypeBinary
           .Open
           .Write HTTPS.ResponseBody
           .SavetoFile Destination
           .Close
       End With
       Set TargetFile = Nothing
     Else
        MsgBox "Unable to Download - Server Response Code " & HTTPS.Status
     End If
     
ErrHandler:
     If Err.Number <> 0 Then MsgBox "Error " & Err.Number & " - " & Err.Description
     Set HTTPS = Nothing
End Sub

I tried it with your code and the URL, and it works for me - but see how you go. Fingers crossed.
 
Upvote 0
@rmplant
Welcome to the MrExcel board!

A couple of pointers since you are a new member
  1. As @Dan_W has already pointed out, you can tag a member within a post as I have done in this post. Please do not try to seek help from particular member(s) by including their user name in a thread title. I have removed that part of your thread title.

  2. When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug. My signature block below has more details. I have added the tags for you this time.
 
Last edited:
Upvote 0
I was so fixated with the error you were getting, that it didn't even occur to me to suggest an alternative - my apologies.

Assuming that you have access to COM objects - and it's not entirely clear that you will do - you might try replacing the above DownloadFile function with the following:

VBA Code:
Sub DownloadFile(ByVal SourceURL As String, ByVal Destination As String)

    Dim HTTPS           As Object
    Dim TargetFile      As Object
    Set HTTPS = CreateObject("WinHttp.WinHttpRequest.5.1")
    On Error GoTo ErrHandler
   
    HTTPS.Open "GET", SourceURL, False
    HTTPS.send

    If HTTPS.Status = 200 Then
       Set TargetFile = CreateObject("ADODB.Stream")
       DoEvents
       With TargetFile
           .Type = 1 ' Early-binding constant = adTypeBinary
           .Open
           .Write HTTPS.ResponseBody
           .SavetoFile Destination
           .Close
       End With
       Set TargetFile = Nothing
     Else
        MsgBox "Unable to Download - Server Response Code " & HTTPS.Status
     End If
    
ErrHandler:
     If Err.Number <> 0 Then MsgBox "Error " & Err.Number & " - " & Err.Description
     Set HTTPS = Nothing
End Sub

I tried it with your code and the URL, and it works for me - but see how you go. Fingers crossed.
Dan, first Thank You for your quick response. I am running into a few problems and have some questions.
First some answers. I am running Windows 11 (18.0.1) (53056) and Office 16. I have access to MS Excel from both my Mac Side and Windows side.

I went into my options to see what COM add-ins I had and checked off Microsoft Power Map for Excel - not sure if this is what I need or not so can you tell me if I need to download or find the COM file that I need to activate or use? Thanks.

When I replace the code above with the original code this Macro DOES NOT display in my list under Macros. WHY? I can get to it via Edit of a one line Range("C1").Select macro, select Module I have your code is located and try to RUN it from there. But it will NOT run. I have backed up my file that I had last night adding -OLD to it and saved this one with a -NEW on the end. Using just the one with -NEW on the end, again I do NOT see either the Module with the Option Explicit on top OR the SubDownloadFile. BUT I did on the -OLD wordbook get an error message the of ambiguous or duplicate SubDownloadFile.

So I tried placing ALL of the code as below in to just ONE NEW Module and that still does not work. Does this have something to do with the COM files or access you were talking about


Option Explicit
#If VBA7 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

Public Function DownloadFile(ByVal URL As String, ByVal DestinationFile As String) As Boolean
' If the API returns ERROR_SUCCESS (0), DownloadFile returns True.

Dim Error_Success As Integer

DownloadFile = (URLDownloadToFile(0&, URL, DestinationFile, &H10, 0&) = CLng(Error_Success))
End Function

Sub DownloadFiles(ByVal SourceURL As String, ByVal Destination As String)

Dim HTTPS As Object
Dim TargetFile As Object
Set HTTPS = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error GoTo ErrHandler

HTTPS.Open "GET", SourceURL, False
HTTPS.send

If HTTPS.Status = 200 Then
Set TargetFile = CreateObject("ADODB.Stream")
DoEvents
With TargetFile
.Type = 1 ' Early-binding constant = adTypeBinary
.Open
.Write HTTPS.ResponseBody
.SavetoFile Destination
.Close
End With
Set TargetFile = Nothing
Else
MsgBox "Unable to Download - Server Response Code " & HTTPS.Status
End If

ErrHandler:
If Err.Number <> 0 Then MsgBox "Error " & Err.Number & " - " & Err.Description
Set HTTPS = Nothing
End Sub


As you can see I am NOT the brightest when it comes to creating MACROS but do fairly well with most of the things I have to accomplish.

Thanks for your time and effort and sorry to be wasting so much of it.

Regards,

rmplant
 
Upvote 0
@rmplant
Please post your last code again - using the code tags as per point 2 of my previous post.
 
Upvote 0
Hi, it's not quite what I meant re: COM but that's ok. We'll find out soon enough - either the code will work or it won't :)

In terms of the code, I had intended that you should be able to use your existing code (with the loop and the logic identifying what is to be downloaded) which you've called Download_NMC_And_Copy, with this alternative replacement DownloadFile routine. But that's ok - I've reproduced the entirety of what I think you'll need (in theory) below. I changed the name of the DownloadFile routine to DownloadFileCOM because I noticed that the earlier code you were trying has declared the same named function to be public. This will just confuse VBA, so lets call this version DownloadFileCOM.

As to why you can't see it in the list of available macros, that list only shows subroutines that run without any additional programmatic input from the user - like your Download_NMC_And_Copy, for example. Whereas the DownloadFile (now, DownLoadFileCOM) requires two arguments - the source URL and the destination filepath. Hope that makes sense, but let me know if not.

In any event, the code below is (hopefully) selfcontained. I'd recommend putting it in its own module and see how it goes.


VBA Code:
Sub Download_NMC_And_Copy()

    Dim DocumentURL         As String
    Dim DestinationFile     As String
    Dim FileName            As String
    Dim imax                As Integer
    Dim icount              As Integer
    
    imax = 178     ' In Column B, starting at Row 2, I have the 178 file names listed that I need to download
    icount = 2      ' Because it is Row 2

    Application.ScreenUpdating = True

    Do While icount <= imax
        FileName = Range("B" & icount)
        DocumentURL = "https://www.dco.uscg.mil/Portals/9/NMC/pdfs/examinations/" & FileName            '  "q100_ror_inland-international.pdf"
        DestinationFile = "C:/NMC/2022/" & FileName
        DownloadFileCOM DocumentURL, DestinationFile
        icount = icount + 1
    Loop

End Sub

Sub DownloadFileCOM(ByVal SourceURL As String, ByVal Destination As String)

    Dim HTTPS           As Object
    Dim TargetFile      As Object
    Set HTTPS = CreateObject("WinHttp.WinHttpRequest.5.1")
    On Error GoTo ErrHandler
    
    HTTPS.Open "GET", SourceURL, False
    HTTPS.send

    If HTTPS.Status = 200 Then
       Set TargetFile = CreateObject("ADODB.Stream")
       DoEvents
       With TargetFile
           .Type = 1 ' Early-binding constant = adTypeBinary
           .Open
           .Write HTTPS.ResponseBody
           .SavetoFile Destination
           .Close
       End With
       Set TargetFile = Nothing
     Else
        MsgBox "Unable to Download - Server Response Code " & HTTPS.Status
     End If
     
ErrHandler:
     If Err.Number <> 0 Then MsgBox "Error " & Err.Number & " - " & Err.Description
     Set HTTPS = Nothing
End Sub
 
Upvote 0
Hi, it's not quite what I meant re: COM but that's ok. We'll find out soon enough - either the code will work or it won't :)

In terms of the code, I had intended that you should be able to use your existing code (with the loop and the logic identifying what is to be downloaded) which you've called Download_NMC_And_Copy, with this alternative replacement DownloadFile routine. But that's ok - I've reproduced the entirety of what I think you'll need (in theory) below. I changed the name of the DownloadFile routine to DownloadFileCOM because I noticed that the earlier code you were trying has declared the same named function to be public. This will just confuse VBA, so lets call this version DownloadFileCOM.

As to why you can't see it in the list of available macros, that list only shows subroutines that run without any additional programmatic input from the user - like your Download_NMC_And_Copy, for example. Whereas the DownloadFile (now, DownLoadFileCOM) requires two arguments - the source URL and the destination filepath. Hope that makes sense, but let me know if not.

In any event, the code below is (hopefully) selfcontained. I'd recommend putting it in its own module and see how it goes.


VBA Code:
Sub Download_NMC_And_Copy()

    Dim DocumentURL         As String
    Dim DestinationFile     As String
    Dim FileName            As String
    Dim imax                As Integer
    Dim icount              As Integer
   
    imax = 178     ' In Column B, starting at Row 2, I have the 178 file names listed that I need to download
    icount = 2      ' Because it is Row 2

    Application.ScreenUpdating = True

    Do While icount <= imax
        FileName = Range("B" & icount)
        DocumentURL = "https://www.dco.uscg.mil/Portals/9/NMC/pdfs/examinations/" & FileName            '  "q100_ror_inland-international.pdf"
        DestinationFile = "C:/NMC/2022/" & FileName
        DownloadFileCOM DocumentURL, DestinationFile
        icount = icount + 1
    Loop

End Sub

Sub DownloadFileCOM(ByVal SourceURL As String, ByVal Destination As String)

    Dim HTTPS           As Object
    Dim TargetFile      As Object
    Set HTTPS = CreateObject("WinHttp.WinHttpRequest.5.1")
    On Error GoTo ErrHandler
   
    HTTPS.Open "GET", SourceURL, False
    HTTPS.send

    If HTTPS.Status = 200 Then
       Set TargetFile = CreateObject("ADODB.Stream")
       DoEvents
       With TargetFile
           .Type = 1 ' Early-binding constant = adTypeBinary
           .Open
           .Write HTTPS.ResponseBody
           .SavetoFile Destination
           .Close
       End With
       Set TargetFile = Nothing
     Else
        MsgBox "Unable to Download - Server Response Code " & HTTPS.Status
     End If
    
ErrHandler:
     If Err.Number <> 0 Then MsgBox "Error " & Err.Number & " - " & Err.Description
     Set HTTPS = Nothing
End Sub
Dan,
Thanks for the new code. I entered it under a new module and I do get an error message which, to me, is confusing. Up above you have the document URL for the first file. Here is what I see when I run the code:

First line in your code is right below. Below that is a COPY of the file location from the web - THEY MATCH 100%
DocumentURL = "https://www.dco.uscg.mil/Portals/9/NMC/pdfs/examinations/" & FileName '"q100_ror_inland-international.pdf"
SO WHY am I seeing the below error message?
'From NMC web https://www.dco.uscg.mil/Portals/9/NMC/pdfs/examinations/q100_ror_inland-international.pdf
' Error Message Displayed of "Error -2147012889 - The server name or address could not be resolved"

I must be doing something wrong but do NOT have the slightest idea of what it is.

AGAIN, Thank you.

rmplant
 
Upvote 0
I'm really not sure. A quick search on google of that error message/number seems to suggest that it's a networking problem. I wonder if it might be that your recently upgraded version of Excel doesn't have access to the internet from being blocked by a firewall? If you're running Windows in a virtual machine, does that virtual machine also have access to the internet through the firewall?
 
Upvote 0
A longshot, but in addition to my point about the firewall above, perhaps try changing the following line in the code:
VBA Code:
Set HTTPS = CreateObject("WinHttp.WinHttpRequest.5.1")
to
VBA Code:
Set HTTPS = CreateObject("MSXML2.ServerXMLHTTP")
I haven't had a chance to test this yet, though.
Also, to format your code (and make it easier to follow/find for anyone who might be experiencing the same/similar problem), you just need to select the code and press the VBA button:
1662644648450.png
 
Upvote 0

Forum statistics

Threads
1,215,824
Messages
6,127,081
Members
449,358
Latest member
Snowinx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top