Automate "File Download" Dialog Box Without SendKeys

redbaron06

New Member
Joined
Aug 6, 2010
Messages
44
Hi All,

I was hoping that someone could help me to alternatively automate the IE File Download Dialog Box in VBA (and a second box that states the user opening a file in a different format than stated). I used SendKeys in my code below, which works, sometimes. I have searched high and low to no avail and could use some expert advice.

The code I am using navigates IE to a page, clicks on an image to export the document, and then attempts to click open and ok to open the new workbook. SaveTheData simply activates the other workbook (the new export) then saving and closing it to a specificed destination.

Thanks in advance!

Code:
    Do While IE.readyState <> READYSTATE_COMPLETE Or IE.Busy: DoEvents: Loop
 
    'Get the HTML document of the new page
 
    Set doc = IE.document
 
    max = 10000
 
    For i = 0 To max
    If doc.getElementsByTagName("img").Item(i).getAttribute("title") = "Export data in Excel" Then
    doc.getElementsByTagName("img").Item(i).Click
    Exit For
    End If
    Next
 
    [B]Application.Wait (Now + TimeValue("0:00:02"))[/B]
[B]   SendKeys "{TAB}", True[/B]
[B]   SendKeys "{TAB}", True[/B]
[B]   SendKeys "{ENTER}", True[/B]
 
    Application.Wait (Now + TimeValue("0:00:02"))
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{ENTER}", True
 
    Application.Wait (Now + TimeValue("0:00:04"))
 
    Call SaveTheFile
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
automate the IE File Download Dialog Box in VBA
See http://www.mrexcel.com/forum/showpost.php?p=2508224&postcount=2 for VBA code and http://www.mrexcel.com/forum/showthread.php?t=502298 which also uses the code and discusses the techniques used. For the code to work, you must added the web site domain to IE's trusted sites, as described in the comment at the top of the code.
(and a second box that states the user opening a file in a different format than stated).
The code doesn't handle this box, and I've never seen such a box. If you post the URL of the page concerned I may be able to help further.
 
Upvote 0
John -

This is quite simply briliant! This code works wonderful. Thanks!

In terms of the warning message I received regarding the file type. The site's designers put ".xls" on the ".xml" files. Is there any way that your code could be suplimented to change the file type to FileFormat:=56? If not, no big deal.

Also, I browsed the boards for your code, and saw that others were also running into the Save As Dialog Box when trying to save over a file with the same name. I tried a new private sub with no luck as I do not know how to get the class name of the box. Do you know a way?

Thanks again!!


Window Name is "Save As"
Buttons "Yes" and "No"
Want to Select Yes, one of my few attempts below:


Code:
Private Sub Save_Over_Existing_Click_Yes()
    
    Dim hWnd As Long
    Dim timeout As Date
    
    Debug.Print "Save_Over_Existing_Click_Yes"
        
    'Find the Download complete window, waiting a maximum of 30 seconds for it to appear.  Timeout value is dependent on the
    'size of the download, so make it longer for bigger files
    
    timeout = Now + TimeValue("00:00:30")
    Do
        hWnd = FindWindow(vbNullString, "Save As")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout
    Debug.Print "   Save As window "; Hex(hWnd)
    
    If hWnd Then
        'Find the child Close button
        
        hWnd = FindWindowEx(hWnd, 0, "Button", "&Yes")
        Debug.Print "   Yes button "; Hex(hWnd)
    End If
    
    If hWnd Then
    
        'Click the Close button
        
        SetForegroundWindow (hWnd)
        Sleep 600  'this sleep is required and 600 miiliseconds seems to be the minimum that works
        SendMessage hWnd, BM_CLICK, 0, 0
    End If
End Sub
 
Upvote 0
I'm pleased that my code works on yet another web site.
In terms of the warning message I received regarding the file type. The site's designers put ".xls" on the ".xml" files. Is there any way that your code could be suplimented to change the file type to FileFormat:=56? If not, no big deal.

Is the warning message shown when you download the file manually and click Save (not Open), or when you open it in Excel after downloading it? If the latter then you could add some code which calls Workbooks.Open and then SaveAs. What file type is FileFormat 56?

I have now updated the code to handle the 'File already exists. Do you want to replace it?' window (it clicks the Yes button). This involved changes to the Save_As_Click_Save subroutine and a new File_Already_Exists subroutine. The complete updated code is in the original thread - http://www.mrexcel.com/forum/showpost.php?p=2805320&postcount=25
 
Upvote 0
Thanks again John, works wonderful!

Is the warning message shown when you download the file manually and click Save (not Open), or when you open it in Excel after downloading it?

No, not when you click save, only when you click open. However, I have another macro is calling these files and they need to be in file format 56, which is Excel 97-2003 .xls format rather than a .xlm file just renamed with a .xls extension.

I modified the code to run for 68 files, and so adding a workbooks.open and saveas seems very inefficent, although I already have the script on hand for opening one closed workbook at a time and doing so.


Here is the code that I am working with so far. It works, thanks to you, with the exception of the file format.

Thanks again.

Code:
Sub Test()
 
    Const cURL = "[URL]https://*************/OA_HTML/AppsLocalLogin.jsp[/URL]?"
    Const cUsername = "********"
    Const cPassword = "********"
 
    Dim IE As InternetExplorer
    Dim doc As HTMLDocument
    Dim LoginForm As HTMLFormElement
    Dim UserNameInputBox As HTMLInputElement
    Dim PasswordInputBox As HTMLInputElement
    Dim SignInButton As HTMLInputButtonElement
    Dim HTMLelement As IHTMLElement
    Dim qt As QueryTable
    Dim ExcelTable As HTMLTable
    Dim i As Integer
    Dim max As Integer
    Dim saveInFolder As String
    Dim saveFileName As String
    Dim fileExists As Boolean
    Dim C As Range, PrevCalc As Variant
    Dim tennis1 As String
 
 
    Set IE = New InternetExplorer
 
    IE.Visible = True
    IE.Navigate cURL
 
    'Wait for initial page to load
 
    Do While IE.readyState <> READYSTATE_COMPLETE Or IE.Busy: DoEvents: Loop
 
    Set doc = IE.document
 
    'Get the only form on the page
 
    Set LoginForm = doc.forms(0)
 
    'Get the User Name textbox and populate it
    '< input name="ctl00$ct$UserName" type="text" maxlength="30" id="ctl00_ct_UserName" style="width:160px;" />
 
    Set UserNameInputBox = LoginForm.elements("username")
    UserNameInputBox.Value = cUsername
 
    'Get the password textbox and populate it
    '< input name="ctl00$ct$Password" type="password" maxlength="30" id="ctl00_ct_Password" style="width:160px;" />
    Set PasswordInputBox = LoginForm.elements("password")
    PasswordInputBox.Value = cPassword
 
    'Get the form input button and click it
    '< input type="submit" name="ctl00$ct$uxBtnLogin" value="Sign In" o n c l i c k="javascript:WebForm_DoPostBackWithOptions(new WebForm_PostBackOptions("ctl00$ct$uxBtnLogin", "", true, "Login", "", false, false))" id="ctl00_ct_uxBtnLogin" />
 
    Set SignInButton = LoginForm.elements("*****")
    SignInButton.Click
 
    'Wait for the new page to load
 
    Do While IE.readyState <> READYSTATE_COMPLETE Or IE.Busy: DoEvents: Loop
 
    'Get the HTML document of the new page
 
    Set doc = IE.document
 
    'Wait for the new page to load
 
    Do While IE.readyState <> READYSTATE_COMPLETE Or IE.Busy: DoEvents: Loop
 
    For Each C In Range("BB10:BB77")
    IE.Navigate "[URL]https://***************.aspx?pidx[/URL]=" & C.Value
 
    Do While IE.readyState <> READYSTATE_COMPLETE Or IE.Busy: DoEvents: Loop
 
    IE.Navigate "[URL]https://***************.aspx?pidx[/URL]=" & C.Value
    Do While IE.readyState <> READYSTATE_COMPLETE Or IE.Busy: DoEvents: Loop
 
    max = 10000
 
    For i = 0 To max
    If doc.getElementsByTagName("img").Item(i).getAttribute("title") = "Export data in Excel" Then
    doc.getElementsByTagName("img").Item(i).Click
    Exit For
    End If
    Next
 
    File_Download_Click_Save
 
    saveInFolder = Sheets("INSTRUCTIONS").Range("D18").Value
 
    Save_As_Set_Filename saveInFolder, saveFileName
 
    fileExists = Save_As_Click_Save
    If fileExists Then
    File_Already_Exists Replace:=True
    End If
    Download_complete_Click_Close
 
    Next C
    End Sub
 
 
Private Sub File_Download_Click_Save()
 
    Dim hWnd As Long
    Dim timeout As Date
 
    Debug.Print "File_Download_Click_Save"
 
    'Find the File Download window, waiting a maximum of 30 seconds for it to appear
 
    timeout = Now + TimeValue("00:00:30")
    Do
        hWnd = FindWindow("#32770", "File Download")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout
 
    Debug.Print "   File Download window "; Hex(hWnd)
 
    If hWnd Then
        'Find the child Save button
 
        hWnd = FindWindowEx(hWnd, 0, "Button", "&Save")
        Debug.Print "   Save button "; Hex(hWnd)
    End If
 
    If hWnd Then
 
        'Click the Save button
 
        SetForegroundWindow (hWnd)
        Sleep 600  'this sleep is required and 600 miiliseconds seems to be the minimum that works
        SendMessage hWnd, BM_CLICK, 0, 0
    End If
End Sub
Private Sub Save_As_Set_Filename(folder As String, filename As String)
 
    Dim hWnd As Long
    Dim timeout As Date
    Dim fullFilename As String
 
    Debug.Print "Save_As_Set_Filename " & folder
 
    'Find the Save As window, waiting a maximum of 10 seconds for it to appear
 
    timeout = Now + TimeValue("00:00:10")
    Do
        hWnd = FindWindow("#32770", "Save As")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout
    If hWnd Then
 
        SetForegroundWindow (hWnd)
 
        'Find the child ComboBoxEx32 window
 
        hWnd = FindWindowEx(hWnd, 0, "ComboBoxEx32", vbNullString)
        Debug.Print "   ComboBoxEx32 "; Hex(hWnd)
    End If
 
    If hWnd Then
 
        'Find the child ComboBox window
 
        hWnd = FindWindowEx(hWnd, 0, "ComboBox", "")
        Debug.Print "   ComboBox "; Hex(hWnd)
    End If
 
    If hWnd Then
 
        SetForegroundWindow (hWnd)
        'Find the child Edit window
 
        hWnd = FindWindowEx(hWnd, 0, "Edit", "")
        Debug.Print "   Edit "; Hex(hWnd)
    End If
 
    filename = ""
 
    If hWnd Then
 
        If filename = "" Then
            'Get default filename (already populated in Edit window)
            filename = Get_Window_Text(hWnd)
        End If
 
        If folder <> "" And Right(folder, 1) <> "\" Then folder = folder & "\"  'if specified, ensure folder ends with \
 
        fullFilename = folder & filename
        Debug.Print "Full filename " & fullFilename
 
        'Populate the Edit window with the full file name
 
        Sleep 200
        SendMessageByString hWnd, WM_SETTEXT, Len(fullFilename), fullFilename
    End If
 
End Sub
Private Function Save_As_Click_Save() As Boolean
    'Click the Save button in the Save As dialogue, returning True if the ' already exists'
    'window appears, otherwise False
 
    Dim hWnd As Long, hWndSaveAs As Long
    Dim timeout As Date
 
    Debug.Print "Save_As_Click_Save"
    'Find the Save As window, waiting a maximum of 10 seconds for it to appear
 
    timeout = Now + TimeValue("00:00:10")
    Do
        hWnd = FindWindow(vbNullString, "Save As")
        hWndSaveAs = hWnd
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout
    Debug.Print "   Save As window "; Hex(hWnd)
    If hWnd Then
 
        SetForegroundWindow hWnd
 
        'Get the child Save button
 
        hWnd = FindWindowEx(hWnd, 0, "Button", "&Save")
        Debug.Print "   Save button "; Hex(hWnd)
    End If
 
    If hWnd Then
 
        'Click the Save button
 
        'This can cause the ' already exists' popup window to be displayed.  The button click is sent with PostMessage
        'because SendMessage doesn't return until the window is closed (by clicking Yes or No)
 
        'PostMessage - [URL]http://msdn.microsoft.com/en-us/library/ms644944%28v=VS.85%29.aspx[/URL]
        'Places (posts) a message in the message queue associated with the thread that created the specified window and returns
        'without waiting for the thread to process the message.
 
        'SendMessage - [URL]http://msdn.microsoft.com/en-us/library/ms644950%28VS.85%29.aspx[/URL]
        'The SendMessage function calls the window procedure for the specified window and does not return until the
        'window procedure has processed the message.
 
        'SendMessage hWnd, BM_CLICK, 0, 0
        Sleep 100
        SetForegroundWindow hWnd
        PostMessage hWnd, BM_CLICK, 0, 0
        Debug.Print "   Clicked Save button"
    End If
 
    If hWnd Then
 
        'Set function return value depending on whether or not the ' already exists' popup window exists
 
        'Note - the popup window is a modal dialogue box and a child of the main Save As window.  Both windows have the
        'same class (#32770) and caption (Save As).  This may present a problem in finding the popup window, however in all tests
        'FindWindow has correctly found the popup window.  Therefore the additional FindWindowEx, which looks for the Yes button
        'as a child of the popup window is not necessary
 
        Sleep 500
        hWnd = FindWindow("#32770", "Save As")
 
        'This alternative FindWindowEx call, which looks for the popup window as a child of the main Save As window, doesn't find it,
        'returning 0 for hWnd
        'hWnd = FindWindowEx(hWndSaveAs, 0, "#32770", "Save As")
 
        Debug.Print "   Save As -  already exists popup window "; Hex(hWnd)
        'hWnd = FindWindowEx(hWnd, 0, "Button", "&Yes")
 
        If hWnd Then
            Save_As_Click_Save = True
        Else
            Save_As_Click_Save = False
        End If
 
    End If
 
End Function
 
 
Private Function Get_Window_Text(hWnd As Long) As String
    'Returns the text in the specified window
 
    Dim buffer As String
    Dim length As Long
    Dim result As Long
 
    length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
    buffer = Space(length + 1)  '+1 for the null terminator
    result = SendMessage(hWnd, WM_GETTEXT, Len(buffer), ByVal buffer)
    Debug.Print "Edit File name = " & Left(buffer, length)
    Debug.Print "     length = " & length
 
    Get_Window_Text = Left(buffer, length)
 
End Function
Private Sub File_Already_Exists(Replace As Boolean)
    'Click Yes or No in the ' already exists. Do you want to replace it?' window
 
    Dim hWnd As Long
 
    Debug.Print "File_Already_Exists("; Replace; ")"
    hWnd = FindWindow("#32770", "Save As")
    Debug.Print "   Save As popup window "; Hex(hWnd)
 
    If hWnd Then
        If Replace Then
            hWnd = FindWindowEx(hWnd, 0, "Button", "&Yes")
            Debug.Print "   Yes button "; Hex(hWnd)
        Else
            hWnd = FindWindowEx(hWnd, 0, "Button", "&No")
            Debug.Print "   No button "; Hex(hWnd)
        End If
    End If
 
    If hWnd Then
        SendMessage hWnd, BM_CLICK, 0, 0
    End If
End Sub
Private Sub Download_complete_Click_Close()
 
    Dim hWnd As Long
    Dim timeout As Date
 
    Debug.Print "Download_complete_Click_Close"
 
    'Find the Download complete window, waiting a maximum of 30 seconds for it to appear.  Timeout value is dependent on the
    'size of the download, so make it longer for bigger files
 
    timeout = Now + TimeValue("00:00:30")
    Do
        hWnd = FindWindow("#32770", "Download complete")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout
    Debug.Print "   Download complete window "; Hex(hWnd)
 
    If hWnd Then
        'Find the child Close button
 
        hWnd = FindWindowEx(hWnd, 0, "Button", "Close")
        Debug.Print "   Close button "; Hex(hWnd)
    End If
 
    If hWnd Then
 
        'Click the Close button
 
        SetForegroundWindow (hWnd)
        Sleep 600  'this sleep is required and 600 miiliseconds seems to be the minimum that works
        SendMessage hWnd, BM_CLICK, 0, 0
    End If
End Sub
 
Upvote 0
No, not when you click save, only when you click open.
My code only clicks Save (to download and save the file to the local hard drive), so the warning displayed when you click Open is irrelevant as far as the download automation is concerned.
However, I have another macro is calling these files and they need to be in file format 56, which is Excel 97-2003 .xls format rather than a .xlm file just renamed with a .xls extension.
If you want the code to save the downloaded file with a .xls extension instead of the .xlm extension supplied by the web site then you should specify the filename string in the saveFileName variable, for example:

Code:
saveFileName = "Download_file.xls"
Save_As_Set_Filename saveInFolder, saveFileName
Moreover, I see from your code that you loop through each cell in "BB10:BB77", downloading a file each time. To prevent the same file name being used and overwriting the previously downloaded file, you will need to specify a unique file name for the saveFileName variable, for example:
Code:
saveFileName = "Download_file_" & C.Value
Save_As_Set_Filename saveInFolder, saveFileName
I assuming that C.Value is different for each cell. If not, use another value which makes the file name unique, for example a time string:
Code:
saveFileName = "Download_file_" & Format(Now, "yyyymmdd_hhmmss")
 
Upvote 0
The problem with opening the file is probably caused by a security setting.

I think it was introduced in Excel 2007.

You can change or turn it off and as far as I know doing so has no adverse effect.

I can't recall the exact setting but it's something to do with unrecognized file formats.
 
Upvote 0
You can change or turn it off and as far as I know doing so has no adverse effect.

Hi Norie. Thanks! Its called Extension Hardening - and its driving me crazy. Acording to our friends at MS you can turn it off using the registry (individual users only) or changing group policy (dont have access to this). Neither of which seem to work all the time or apply the removal of the setting to all users of the workbook.

http://support.microsoft.com/kb/948615

This is causing me problems because when I attempt to open the workbook using VBA, even to resave it after saving it with vba using

Code:
Sub SaveTheFile()
Dim C As Range, PrevCalc As Variant
Dim TangoDelta As String
Dim TangoAlpha As String
TangoDelta = *******
TangoAlpha = *******
For Each C In Range("W2:W69")
Workbooks.Open filename:=Range("D18").Value & C
Workbooks(TangoDelta).Activate
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs TangoAlpha, FileFormat:=56
Application.DisplayAlerts = True
ActiveWorkbook.Close
Next C
End Sub

or similar code the process is stopped by this warning message. When I attempt to open it before saving, it bypasses the warning untill the script has run all the way through, and only gives me a warning for the first file.
 
Upvote 0
Well I turned it off using Group Policy Editor, but that was only because it was available.

I did see the registery option though.

Whichever method you use if this is going to work for all users then they'll need to change the setting.

You might even need to get someone in IT to do it.:)

PS I tried resaving etc but could never get it to work, it was only when I stumbled on this setting that I resolved the problem.
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

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