Access VB download Excel file from website

**lizzycole** · 03-26-2013, 10:32 PM

I would like to start off by stating that I have done, what I consider to be, quite a lot of research (google, forums, etc) on this topic and have not yet found the answer to my question. Thank you for any assistance you are able to provide.

I am currently doing this manually, but I have no back up in place (no one else on the team is "tech savvy" - their words - not mine!

). This isn't something I want to have to do every, single morning for the rest of my life...

Access http://soandsoreports/date_list.xls - save the file to a intranet drive structure - update access tables connected to this file.

I found the below code based on another thread (all credit to Chip Pearson) and it was helpful, but I do not fully understand how to incorporate it into my database.

Code:

Option Explicit
Option Compare Text

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modDownloadFile
' By Chip Pearson, chip@cpearson.com, www.cpearson.com/Excel/DownloadFile.aspx
' Date: 23-April-2003
' This module contains the DownloadFile function and supporting players to
' download a file from a URL to a local file name.
'
' Example Usage:
'
'        Dim URL As String
'        Dim LocalFileName As String
'        Dim B As Boolean
'        Dim ErrorText As String
'
'        URL = "http://www.cpearson.com/Zips/FindAll.zip"
'        LocalFileName = "C:\Test\FindAll.zip"
'        B = DownloadFile(UrlFileName:=URL, _
'                        DestinationFileName:=LocalFileName, _
'                        Overwrite:=OverwriteRecycle, _
'                        ErrorText:=ErrorText)
'        If B = True Then
'            Debug.Print "Download successful"
'        Else
'            Debug.Print "Download unsuccessful: " & ErrorText
'        End If
'
' The Overwrite parameter of DownloadFile indicates how to handle the
' case when LocalFileName already exists. It is one of the following
' values:
'        OverwriteKill      use Kill to delete the existing file.
'        OverwriteRecycle   send the existing file to the Recycle Bin.
'        DoNotOverwrite     do not overwrite and terminate the procedure.
'        PromptUser         prompt the user asking whether to overwrite file.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Enum DownloadFileDisposition
    OverwriteKill = 0
    OverwriteRecycle = 1
    DoNotOverwrite = 2
    PromptUser = 3
End Enum

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Windows API functions, constants,and types.
' Used for RecycleFile.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function SHFileOperation Lib "shell32.dll" Alias _
    "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" _
    Alias "PathIsNetworkPathA" ( _
    ByVal pszPath As String) As Long

Private Declare Function GetSystemDirectory Lib "kernel32" _
    Alias "GetSystemDirectoryA" ( _
    ByVal lpBuffer As String, _
    ByVal nSize As Long) As Long

Private Declare Function SHEmptyRecycleBin _
    Lib "shell32" Alias "SHEmptyRecycleBinA" _
    (ByVal hwnd As Long, _
     ByVal pszRootPath As String, _
     ByVal dwFlags As Long) As Long

Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const MAX_PATH As Long = 260

Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

'''''''''''''''''''''''''''
' Download API function.
''''''''''''''''''''''''''''''''''''''
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

Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias _
    "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DownloadFile
' This downloads a file from a URL to a local filename.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function DownloadFile(UrlFileName As String, _
                            DestinationFileName As String, _
                            Overwrite As DownloadFileDisposition, _
                            ErrorText As String) As Boolean

Dim Disp As DownloadFileDisposition
Dim Res As VbMsgBoxResult
Dim B As Boolean
Dim S As String
Dim L As Long

ErrorText = vbNullString

If Dir(DestinationFileName, vbNormal) <> vbNullString Then
    Select Case Overwrite
        Case OverwriteKill
            On Error Resume Next
            Err.Clear
            Kill DestinationFileName
            If Err.Number <> 0 Then
                ErrorText = "Error Kill'ing file '" & DestinationFileName & "'." & vbCrLf & Err.Description
                DownloadFile = False
                Exit Function
            End If
    
        Case OverwriteRecycle
            On Error Resume Next
            Err.Clear
            B = RecycleFileOrFolder(DestinationFileName)
            If B = False Then
                ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & Err.Description
                DownloadFile = False
                Exit Function
            End If
        
        Case DoNotOverwrite
            DownloadFile = False
            ErrorText = "File '" & DestinationFileName & "' exists and disposition is set to DoNotOverwrite."
            Exit Function
            
        'Case PromptUser
        Case Else
            S = "The destination file '" & DestinationFileName & "' already exists." & vbCrLf & _
                "Do you want to overwrite the existing file?"
            Res = MsgBox(S, vbYesNo, "Download File")
            If Res = vbNo Then
                ErrorText = "User selected not to overwrite existing file."
                DownloadFile = False
                Exit Function
            End If
            B = RecycleFileOrFolder(DestinationFileName)
            If B = False Then
                ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & Err.Description
                DownloadFile = False
                Exit Function
            End If
    End Select
End If
L = DeleteUrlCacheEntry(UrlFileName)
L = URLDownloadToFile(0&, UrlFileName, DestinationFileName, 0&, 0&)
If L = 0 Then
    DownloadFile = True
Else
    ErrorText = "Buffer length invalid or not enough memory."
    DownloadFile = False
End If
    
End Function
                            
Private Function RecycleFileOrFolder(FileSpec As String) As Boolean

    Dim FileOperation As SHFILEOPSTRUCT
    Dim lReturn As Long

    If (Dir(FileSpec, vbNormal) = vbNullString) And _
        (Dir(FileSpec, vbDirectory) = vbNullString) Then
        RecycleFileOrFolder = True
        Exit Function
    End If

    With FileOperation
        .wFunc = FO_DELETE
        .pFrom = FileSpec
        .fFlags = FOF_ALLOWUNDO
' Or
        .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
    End With

    lReturn = SHFileOperation(FileOperation)
    If lReturn = 0 Then
        RecycleFileOrFolder = True
    Else
        RecycleFileOrFolder = False
    End If
End Function

**June7** · 03-27-2013, 12:07 AM

This is how should be implemented.

Copy/paste the code into a general module.

Call the DownloadFile function from some event, maybe a button click or test it in the VBA Immediate Window.

DownloadFile("http://soandsoreports/date_list.xls", "C:\date_list.xls", OverwriteRecycle, "Error")

The code runs but the download fails because I guess the http link for the xls file is a dummy url.

This test works:

DownloadFile("http://www.cpearson.com/Zips/FindAll.zip", "C:\FindAll.zip", OverwriteRecycle ,"Error")

**lizzycole** · 03-27-2013, 07:02 AM

So do I just need the one line of code "downloadfile..." Or the entire code I pasted above?

**lizzycole** · 03-27-2013, 07:05 AM

And if I need to use the full code, do I need to remove any of the " ' " in front of parts of the code to make them actual code?

**June7** · 03-27-2013, 12:28 PM

No. Just copy/paste the code as is. The lines with apostrophe in front are comments.

I did not change a thing and the code ran.

The only thing you will modify is the statement calling the function.

**lizzycole** · 03-27-2013, 09:11 PM

I don't think I am entering it properly. I am getting an error - "Compile error: Expected: identifier"

I have pasted the entire code here as I have it in my database. The only thing I have edited is the area with red text.

Code:

Option Explicit
Option Compare Text
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modDownloadFile
' By Chip Pearson, chip@cpearson.com, www.cpearson.com/Excel/DownloadFile.aspx
' Date: 23-April-2003
' This module contains the DownloadFile function and supporting players to
' download a file from a URL to a local file name.
'
' Example Usage:
'
'        Dim URL As String
'        Dim LocalFileName As String
'        Dim B As Boolean
'        Dim ErrorText As String
'
'        URL = "http://www.cpearson.com/Zips/FindAll.zip"
'        LocalFileName = "C:\Test\FindAll.zip"
'        B = DownloadFile(UrlFileName:=URL, _
'                        DestinationFileName:=LocalFileName, _
'                        Overwrite:=OverwriteRecycle, _
'                        ErrorText:=ErrorText)
'        If B = True Then
'            Debug.Print "Download successful"
'        Else
'            Debug.Print "Download unsuccessful: " & ErrorText
'        End If
'
' The Overwrite parameter of DownloadFile indicates how to handle the
' case when LocalFileName already exists. It is one of the following
' values:
'        OverwriteKill      use Kill to delete the existing file.
'        OverwriteRecycle   send the existing file to the Recycle Bin.
'        DoNotOverwrite     do not overwrite and terminate the procedure.
'        PromptUser         prompt the user asking whether to overwrite file.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Enum DownloadFileDisposition
    OverwriteKill = 0
    OverwriteRecycle = 1
    DoNotOverwrite = 2
    PromptUser = 3
End Enum
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Windows API functions, constants,and types.
' Used for RecycleFile.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function SHFileOperation Lib "shell32.dll" Alias _
    "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" _
    Alias "PathIsNetworkPathA" ( _
    ByVal pszPath As String) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" _
    Alias "GetSystemDirectoryA" ( _
    ByVal lpBuffer As String, _
    ByVal nSize As Long) As Long
Private Declare Function SHEmptyRecycleBin _
    Lib "shell32" Alias "SHEmptyRecycleBinA" _
    (ByVal hwnd As Long, _
     ByVal pszRootPath As String, _
     ByVal dwFlags As Long) As Long
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const MAX_PATH As Long = 260
Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type
'''''''''''''''''''''''''''
' Download API function.
''''''''''''''''''''''''''''''''''''''
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
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias _
    "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DownloadFile
' This downloads a file from a URL to a local filename.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function DownloadFile("http://elmsreports/seasonal_date_list.xls" As String, _
                            "\\whqntfsx01\dept01\supply\Field Sourcing\Release Management\Push Requests\Push Order Generator\Database Supporting Files\seasonal_date_list.xls" As String, _
                            OverwriteRecycle As DownloadFileDisposition, _
                            ErrorText As String) As Boolean
Dim Disp As DownloadFileDisposition
Dim Res As VbMsgBoxResult
Dim B As Boolean
Dim S As String
Dim L As Long
ErrorText = vbNullString
If Dir(DestinationFileName, vbNormal) <> vbNullString Then
    Select Case Overwrite
        Case OverwriteKill
            On Error Resume Next
            Err.Clear
            Kill DestinationFileName
            If Err.Number <> 0 Then
                ErrorText = "Error Kill'ing file '" & DestinationFileName & "'." & vbCrLf & Err.Description
                DownloadFile = False
                Exit Function
            End If
    
        Case OverwriteRecycle
            On Error Resume Next
            Err.Clear
            B = RecycleFileOrFolder(DestinationFileName)
            If B = False Then
                ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & Err.Description
                DownloadFile = False
                Exit Function
            End If
        
        Case DoNotOverwrite
            DownloadFile = False
            ErrorText = "File '" & DestinationFileName & "' exists and disposition is set to DoNotOverwrite."
            Exit Function
            
        'Case PromptUser
        Case Else
            S = "The destination file '" & DestinationFileName & "' already exists." & vbCrLf & _
                "Do you want to overwrite the existing file?"
            Res = MsgBox(S, vbYesNo, "Download File")
            If Res = vbNo Then
                ErrorText = "User selected not to overwrite existing file."
                DownloadFile = False
                Exit Function
            End If
            B = RecycleFileOrFolder(DestinationFileName)
            If B = False Then
                ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & Err.Description
                DownloadFile = False
                Exit Function
            End If
    End Select
End If
L = DeleteUrlCacheEntry(UrlFileName)
L = URLDownloadToFile(0&, UrlFileName, DestinationFileName, 0&, 0&)
If L = 0 Then
    DownloadFile = True
Else
    ErrorText = "Buffer length invalid or not enough memory."
    DownloadFile = False
End If
    
End Function
                            
Private Function RecycleFileOrFolder(FileSpec As String) As Boolean
    Dim FileOperation As SHFILEOPSTRUCT
    Dim lReturn As Long
    If (Dir(FileSpec, vbNormal) = vbNullString) And _
        (Dir(FileSpec, vbDirectory) = vbNullString) Then
        RecycleFileOrFolder = True
        Exit Function
    End If
    With FileOperation
        .wFunc = FO_DELETE
        .pFrom = FileSpec
        .fFlags = FOF_ALLOWUNDO
' Or
        .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
    End With
    lReturn = SHFileOperation(FileOperation)
    If lReturn = 0 Then
        RecycleFileOrFolder = True
    Else
        RecycleFileOrFolder = False
    End If
End Function

**June7** · 03-27-2013, 11:09 PM

Do not edit those lines. Put them back the way they were. That is the function that needs to be called.

Call the function from some other event, such as a button Click, like:

Sub btnGetFile_Click()
Dim booDown As Boolean
booDown = DownloadFile("http://elmsreports/seasonal_date_list.xls", "\\whqntfsx01\dept01\supply\Field Sourcing\Release Management\PushRequests\Push Order Generator\Database Supporting Files\seasonal_date_list.xls", OverwriteRecycle, "Download Error")
MsgBox "File download was " & IIf(booDown, "successful", "not successful.")
End Sub

**lizzycole** · 04-01-2013, 02:54 PM

I would like to report back that I have now "Solved" my issue. I did not initially understand that there were really separate steps to this. For anyone else that is needing additional assistance:
1. Go to Database Tools and Open VB
2. Copy and paste the code from Chip Pearson into a Standard VB Module (make sure to name the Module something different than the Function - I initially had errors because of this; example: name the Module modDownloadFile - the Function is already named DownloadFile)
3. Close VB and go back to your database
4. Go to Create - Macro
5. In the Action Column, use "RunCode";
6. For Arguments, use the "..." to open the Expression Builder
7. Expand Functions --> Your Database Name --> modDownloadFile --> DownloadFile
8. This will give you your expression and you will just fill it in from there Example: DownloadFile («UrlFileName», «DestinationFileName», «Overwrite», «ErrorText»)
Mine reads: DownloadFile ("http://soandsoreports/seasonal_date_list.xls", "\\whqfsx01\deptXX\supply\Field Sourcing\Release Management\Push Requests\Push Order Generator\Database Supporting Files\seasonal_date_list.xls", 1, "Error")
I actually set this up to do 4 different downloads by just repeating the RunCode/DownloadFile lines for each file

Note on paths to network drives: Make sure to find out your "full" path and do not use named drives. Example: instead of "G:\supply", I use \\whqntfsx01\deptXX\supply. The reason for this is because named drives (G, R, H, etc) are arbitrary and can be set up by different users. If you get the standard - you will have a lot less issues.

Optional Add to Button:
1. Do all of the above
2. In your form, create a new button from Design --> Controls (make sure Use Control Wizards is highlighted for easiest use)
3. Choose a place on the screen for your button and the wizard will open
4. Choose Categories: Miscellaneous -- Actions: Run Macro
5. Select your macro
6. Change your text or picture
7. Name your button

Hope this helps someone else out in the future!!

Access VB download Excel file from website

Thread Tools

Access VB download Excel file from website

Similar Threads

I need to automatically download and import an Excel file from an email

Download Excel sheets into contacts

import excel file to access 2003 yes, access 2007 no

Access link to excel file

download test file from WS_FTPin Access VBA

Posting Permissions