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
