none
VBA to download a file without a direct URL RRS feed

  • Question

  • I'm new to using VBA for internet related automation.

    Trying to automate a process which downloads a report xlsx from a web application - many as part of a loop (IE11).

    Because the URL isn't the path to the file, it's a 'file request link' it processes single signon verification, then the download popup is displayed.

    Is there a way I can automatically download this file?  (At the moment I've set Chrome to automatically download to a folder, so when I open it with the URL it saves the file automatically, but I'd prefer to avoid the use of Chrome entirely.)

    Thursday, April 7, 2016 1:18 AM

All replies

  • It really depends on the web site, but I have been able to do that with code like this, using MS IE

    Option Explicit

    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
    (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

    Private x As Integer
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long

    'Used a user defined type here rather than Enum so that it works on 97
    Private Type winEnum
        winHandle As Integer
        winClass As Integer
        winTitle As Integer
        winHandleClass As Integer
        winHandleTitle As Integer
        winHandleClassTitle As Integer
    End Type
    Dim winOutputType As winEnum
    Public IE As InternetExplorer
    Public strT As String
    Public shtH As Worksheet


    Sub GetFileFromWebsite()

        strT = "0:00:03"
        Set shtH = Worksheets.Add(After:=Sheets(1))

        Set IE = CreateObject("InternetExplorer.Application")

        With IE
            .Visible = True
            Application.Wait (Now + TimeValue(strT))
            .Navigate "http://www.whatever.com/Login"

            Application.Wait (Now + TimeValue(strT))

            Do Until .ReadyState = 4
                DoEvents
            Loop

            .Document.all.Item("IDToken1").Value = "username"
            .Document.all.Item("IDToken2").Value = "sassword"
            .Document.forms(0).submit

            Application.Wait (Now + TimeValue(strT))

            Do Until .ReadyState = 4
                DoEvents
            Loop

            .Navigate "http://www.whatever.com/DownloadPage"

            Application.Wait (Now + TimeValue(strT))

            Do Until .ReadyState = 4
                DoEvents
            Loop

            .Document.getElementsByName("GetFile").Item(0).Click
             Application.Wait (Now + TimeValue(strT))
            ' GetWindows 0   'This is needed if there is a pop up window and you need to click a specific button
            ' FindButton      'This is needed if there is a pop up window and you need to click a specific button
            .Quit
        End With

    End Sub

    'Maybe not needed
    Public Sub GetWindows(HParentWind As Variant)

        winOutputType.winHandle = 0
        winOutputType.winClass = 1
        winOutputType.winTitle = 2
        winOutputType.winHandleClass = 3
        winOutputType.winHandleTitle = 4
        winOutputType.winHandleClassTitle = 5

        GetWinInfo CLng(HParentWind), 0, winOutputType.winHandleClassTitle
    End Sub


    Private Sub GetWinInfo(hParent As Long, intOffset As Integer, OutputType As Integer)
        'Sub to recursively obtain window handles, classes and text
        'given a parent window to search
        'Written by Mark Rowlinson
        'www.markrowlinson.co.uk - The Programming Emporium

        'writes data to a sheet to be able to search for a specific object

        Dim hwnd As Long, lngRet As Long, Y As Integer
        Dim strText As String
        Dim boolGo As Boolean
        boolGo = False
        hwnd = FindWindowEx(hParent, 0&, vbNullString, vbNullString)
        While hwnd <> 0
            Select Case OutputType
                Case winOutputType.winClass
                strText = String$(100, Chr$(0))
                lngRet = GetClassName(hwnd, strText, 100)
                shtH.Range("a1").Offset(x, intOffset) = Left$(strText, lngRet)
                Case winOutputType.winHandle
                shtH.Range("a1").Offset(x, intOffset) = hwnd
                Case winOutputType.winTitle
                strText = String$(100, Chr$(0))
                lngRet = GetWindowText(hwnd, strText, 100)
                If lngRet > 0 Then
                    shtH.Range("a1").Offset(x, intOffset) = Left$(strText, lngRet)
                Else
                    shtH.Range("a1").Offset(x, intOffset) = "N/A"
                End If
                Case winOutputType.winHandleClass
                shtH.Range("a1").Offset(x, intOffset) = hwnd
                strText = String$(100, Chr$(0))
                lngRet = GetClassName(hwnd, strText, 100)
                shtH.Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                Case winOutputType.winHandleTitle
                shtH.Range("a1").Offset(x, intOffset) = hwnd
                strText = String$(100, Chr$(0))
                lngRet = GetWindowText(hwnd, strText, 100)
                If lngRet > 0 Then
                    shtH.Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                Else
                    shtH.Range("a1").Offset(x, intOffset + 1) = "N/A"
                End If
                Case winOutputType.winHandleClassTitle
                shtH.Range("a1").Offset(x, intOffset) = hwnd
                strText = String$(100, Chr$(0))
                lngRet = GetClassName(hwnd, strText, 100)
                shtH.Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                strText = String$(100, Chr$(0))
                lngRet = GetWindowText(hwnd, strText, 100)
                If lngRet > 0 Then
                    shtH.Range("a1").Offset(x, intOffset + 2) = Left$(strText, lngRet)
                Else
                    shtH.Range("a1").Offset(x, intOffset + 2) = "N/A"
                End If
            End Select
            'check for children
            Y = x
            Select Case OutputType
                Case Is > 4
                GetWinInfo hwnd, intOffset + 3, OutputType
                Case Is > 2
                GetWinInfo hwnd, intOffset + 2, OutputType
                Case Else
                GetWinInfo hwnd, intOffset + 1, OutputType
            End Select
            'increment by 1 row if no children found
            If Y = x Then
                x = x + 1
            End If
            'now get next window
            hwnd = FindWindowEx(hParent, hwnd, vbNullString, vbNullString)
        Wend

    End Sub


    Thursday, April 7, 2016 4:05 PM
  • Selenium Basic has examples of how to do this in Chrome, Firefox and IE.   I just tried Firefox and works perfectly.

    '' ' Sets the download folder with Firefox '' Private Sub Download_File_Firefox() Dim driver As New FirefoxDriver, file As String 'Set the preferences specific to Firefox driver.SetPreference "browser.download.folderList", 2 driver.SetPreference "browser.download.dir", ThisWorkbook.Path driver.SetPreference "browser.helperApps.neverAsk.saveToDisk", "application/pdf" driver.SetPreference "pdfjs.disabled", True ' Init the file waiter WaitNewFile ThisWorkbook.Path & "\*.pdf" ' Open the file for download driver.Get "https://www.mozilla.org/en-US/foundation/documents" driver.FindElementByLinkText("IRS Form 872-C").Click ' Waits for a new file file = WaitNewFile() 'Stop the browser driver.Quit End Sub

    ''
    ' Waits for a new file to be created in a folder
    ' @folder {String}  Folder where the file will be created
    ' Usage:
    '   WaitNewFile "C:\download\*.pdf"
    '   ' The new file is created here
    '   filename = WaitNewFile()
    ''
    Public Function WaitNewFile(Optional target As String) As String
      Static files As Collection, filter$
      Dim file$, file_path$, i&
      If Len(target) Then
        ' Initialize the list of files and return
        filter = target
        Set files = New Collection
        file = Dir(filter, vbNormal)
        Do While Len(file)
          files.Add Empty, file
          file = Dir
        Loop
        Exit Function
      End If
     
      ' Waits for a file that is not in the list
      On Error GoTo WaitReady
      Do
        file = Dir(filter, vbNormal)
        Do While Len(file)
          files.Item file
          file = Dir
        Loop
        For i = 0 To 3000: DoEvents: Next
      Loop
     
    WaitReady:
      ' Waits for the size to be superior to 0 and try to rename it
      file_path = Left$(filter, InStrRev(filter, "\")) & file
      Do
        If FileLen(file_path) Then
          On Error Resume Next
          Name file_path As file_path
          If Err = 0 Then Exit Do
        End If
        For i = 0 To 3000: DoEvents: Next
      Loop
      files.Add Empty, file
      WaitNewFile = file_path
    End Function


     
    Thursday, April 7, 2016 11:35 PM
  • Hi Bernie

    Thanks for this code. I've tried it out, slightly modified to work using the below code.

    It throws a 91 error "Object variable or With block variable not set" on line 64 ".Document.getElementsByName("GetFile").Item(0).Click".  At this point, IE has popped up with the "what do you want to do with this file" open/save/as)

    Looking in the Locals window I cannot see a reference to "getElementsByName" which could be an issue.

    I should have specified, I want the files saved to a folder rather than imported into a Sheet.

    'Option Explicit
    
     Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
     (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
     Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
     (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
     Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
     (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    
     Private x As Integer
     Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
    
     'Used a user defined type here rather than Enum so that it works on 97
     Private Type winEnum
         winHandle As Integer
         winClass As Integer
         winTitle As Integer
         winHandleClass As Integer
         winHandleTitle As Integer
         winHandleClassTitle As Integer
     End Type
     Dim winOutputType As winEnum
     Public IE As InternetExplorer
     Public strT As String
     Public shtH As Worksheet
    
    
     Sub GetFileFromWebsite()
    
         strT = "0:00:03"
         Set shtH = Worksheets.Add(After:=Sheets(1))
    
         Set IE = CreateObject("InternetExplorer.Application")
        vHandle = IE.hwnd
         With IE
             .Visible = True
             Application.Wait (Now + TimeValue(strT))
             .Navigate "http://server/ibmcognos/cgi-bin/cognosisapi.dll?b_action=xts.run&m=portal/cc.xts&m_folder=i92097D02FFDC40E995BBFB084B3275"
    
             Application.Wait (Now + TimeValue(strT))
        End With
    
    'Reattach to IE process
        Set oShell = CreateObject("Shell.Application")
        On Error Resume Next 'skip over bad objects
            For Each Wnd In oShell.Windows
                     If vHandle = Wnd.hwnd Then Set IE = Wnd
            Next
        On Error GoTo 0
        
        With IE
             Do Until .ReadyState = 4
                 DoEvents
             Loop
    
             .Navigate "http://server/ibmcognos/cgi-bin/cognosisapi.dll?b_action=cognosViewer&ui.action=view&ui.object=defaultOutput(%2fcontent%2ffolder%5b%40name%3d%27FOLDER%27%5d%2ffolder%5b%40name%3d%27_Distribution%27%5d%2freportView%5b%40name%3d%272012-13%20Data%20Example%20Filename5d)&ui.name=2012-13%20Data%20Example%20Filename&ui.format=spreadsheetML&ui.backURL=%2fibmcognos%2fcgi-bin%2fcognosisapi.dll%3fb_action%3dxts.run%26m%3dportal%2fcc.xts%26m_folder%3di92097D02FFDC40E995BBFB084B3275"
    
             Application.Wait (Now + TimeValue(strT))
    
             Do Until .ReadyState = 4
                 DoEvents
             Loop
    
             .Document.getElementsByName("GetFile").Item(0).Click
              Application.Wait (Now + TimeValue(strT))
             ' GetWindows 0   'This is needed if there is a pop up window and you need to click a specific button
             ' FindButton      'This is needed if there is a pop up window and you need to click a specific button
             .Quit
         End With
    
     End Sub
    
     'Maybe not needed
     Public Sub GetWindows(HParentWind As Variant)
    
         winOutputType.winHandle = 0
         winOutputType.winClass = 1
         winOutputType.winTitle = 2
         winOutputType.winHandleClass = 3
         winOutputType.winHandleTitle = 4
         winOutputType.winHandleClassTitle = 5
    
         GetWinInfo CLng(HParentWind), 0, winOutputType.winHandleClassTitle
     End Sub
    
    
     Private Sub GetWinInfo(hParent As Long, intOffset As Integer, OutputType As Integer)
         'Sub to recursively obtain window handles, classes and text
         'given a parent window to search
         'Written by Mark Rowlinson
         'www.markrowlinson.co.uk - The Programming Emporium
    
        'writes data to a sheet to be able to search for a specific object
    
        Dim hwnd As Long, lngRet As Long, Y As Integer
         Dim strText As String
         Dim boolGo As Boolean
         boolGo = False
         hwnd = FindWindowEx(hParent, 0&, vbNullString, vbNullString)
         While hwnd <> 0
             Select Case OutputType
                 Case winOutputType.winClass
                 strText = String$(100, Chr$(0))
                 lngRet = GetClassName(hwnd, strText, 100)
                 shtH.Range("a1").Offset(x, intOffset) = Left$(strText, lngRet)
                 Case winOutputType.winHandle
                 shtH.Range("a1").Offset(x, intOffset) = hwnd
                 Case winOutputType.winTitle
                 strText = String$(100, Chr$(0))
                 lngRet = GetWindowText(hwnd, strText, 100)
                 If lngRet > 0 Then
                     shtH.Range("a1").Offset(x, intOffset) = Left$(strText, lngRet)
                 Else
                     shtH.Range("a1").Offset(x, intOffset) = "N/A"
                 End If
                 Case winOutputType.winHandleClass
                 shtH.Range("a1").Offset(x, intOffset) = hwnd
                 strText = String$(100, Chr$(0))
                 lngRet = GetClassName(hwnd, strText, 100)
                 shtH.Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                 Case winOutputType.winHandleTitle
                 shtH.Range("a1").Offset(x, intOffset) = hwnd
                 strText = String$(100, Chr$(0))
                 lngRet = GetWindowText(hwnd, strText, 100)
                 If lngRet > 0 Then
                     shtH.Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                 Else
                     shtH.Range("a1").Offset(x, intOffset + 1) = "N/A"
                 End If
                 Case winOutputType.winHandleClassTitle
                 shtH.Range("a1").Offset(x, intOffset) = hwnd
                 strText = String$(100, Chr$(0))
                 lngRet = GetClassName(hwnd, strText, 100)
                 shtH.Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                 strText = String$(100, Chr$(0))
                 lngRet = GetWindowText(hwnd, strText, 100)
                 If lngRet > 0 Then
                     shtH.Range("a1").Offset(x, intOffset + 2) = Left$(strText, lngRet)
                 Else
                     shtH.Range("a1").Offset(x, intOffset + 2) = "N/A"
                 End If
             End Select
             'check for children
             Y = x
             Select Case OutputType
                 Case Is > 4
                 GetWinInfo hwnd, intOffset + 3, OutputType
                 Case Is > 2
                 GetWinInfo hwnd, intOffset + 2, OutputType
                 Case Else
                 GetWinInfo hwnd, intOffset + 1, OutputType
             End Select
             'increment by 1 row if no children found
             If Y = x Then
                 x = x + 1
             End If
             'now get next window
             hwnd = FindWindowEx(hParent, hwnd, vbNullString, vbNullString)
         Wend
    
     End Sub
    
    

    Friday, April 8, 2016 12:32 AM
  • You should be looking for an element with a name that you press, and replace the "GetFile" with the name of the element 

    getElementsByName("GetFile")

    Every website has elements, and the developer names them whatever they want. You need to view the source code of the page to find the correct element name.

    Friday, April 8, 2016 5:25 PM