'10-Nov-2010
'http://www.mrexcel.com/forum/showthread.php?t=507871
'Note - IE may block the download, displaying its Information Bar at the top of the tab, and preventing this
'program from automatically downloading the file. To prevent this, add http://www.remotedatacentre.com
'to IE's Trusted sites (Tools - Internet Options - Security - Trusted sites - Sites).
Option Explicit
Public Const baseURL As String = "http://www.remotedatacentre.com/co-so/cbstateall.aspx?dist=Chennai-North"
Public Sub Test_Download()
Dim URL As String
'To open the website
URL = "http://www.nrldc.org/WBS/injsch.aspx"
Download_File URL, "", ""
End Sub
Public Sub Download_File(URL As String, saveInFolder As String, saveFilename As String)
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate URL
While .Busy Or .readyState <> 4: DoEvents: Wend
.navigate "javascript:__doPostBack('downloadncr','')"
End With
File_Download_Click_Save
Save_As_Set_Filename saveInFolder, saveFilename
Save_As_Click_Save
Download_complete_Click_Close
Debug.Print "Finished"
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 Test_Save_As_Set_Filename()
'Test setting the Save As filename. The Save As window must be displayed before running this
Dim theFolder As String, theFilename As String
theFolder = ThisWorkbook.Path & "\"
theFilename = "test " & Format(Now, "hh_mm_ss") & ".csv"
Save_As_Set_Filename theFolder, theFilename
End Sub
Private Sub Save_As_Set_Filename(folder As String, filename As String)
'Populate the 'File name:' edit window in the Save As dialogue with the specified folder and/or filename.
'If folder = "" a folder path is not prepended and therefore the default save folder is used.
'If filename = "" the default file name (already populated) is used.
'The Save As window has the following child window hierarchy:
' "Save As", #32770 Dialog
' "FileName2011_11_11_11_00_26", ComboBoxEx32 (default value in combobox)
' "", ComboBox
' "FileName2011_11_11_11_00_26"", Edit (default value in combobox's edit box)
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
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 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 Save_As_Click_Save()
'Click the Save button in the Save As dialogue
Dim hWnd 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")
DoEvents
Sleep 200
Loop Until hWnd Or Now > timeout
If hWnd Then
SetForegroundWindow (hWnd)
'Get the child Save button
hWnd = FindWindowEx(hWnd, 0, "Button", "&Save")
Debug.Print " Save button "; hWnd
End If
If hWnd Then
'Click the Save button
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
