-
Ok, I guess this is a bit of a tricky one so I'll stick with what I've got. I've tweaked the code a little and it works consistently now. I've also changed the code so it checks for both the 'File Download' and the newer 'Frame Notification Bar' in the same loop. Code is below, thought it might be useful to someone.
[VBA]Sub LinkToSPICE(Optional SelectedAttachment As String)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''
''' Links to SPICE website and if an attachment name has been given, opens the file
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''
Dim IE As Object
Dim IeHandle As Long, FileDownloadHandle As Long, OpenButtonHandle As Long, IePopupBarHandle As Long
Dim AutoMode As Boolean, FileDownloadClassicPopup As Boolean, DownloadComplete As Boolean
Dim Timeout As Date
Dim strSPICE As String, strLink As String
Dim PopupGap As Integer, i As Integer
'sets how much smaller the IE window is than the Excel window
PopupGap = 30
'user defined option, in case auto mode fails they can manually open attachment
If SelectedAttachment = "" Then AutoMode = False Else AutoMode = True
'create the URL to the web page
With ThisWorkbook
strSPICE = .Sheets(shtCapture).Range("Rng_SPICEref")
strLink = .Sheets(shtRef).Range("SPICE_PREFIX") & strSPICE
End With
Set IE = CreateObject("InternetExplorer.application")
'Get the windows handle for the new IE instance
IeHandle = IE.hwnd
If AutoMode = False Then
'Manual mode - just opens the relevant web page, user has to select and open file
With IE
.Left = (Application.Left * PointsToPixels) + PopupGap
.Top = (Application.Top * PointsToPixels) + PopupGap
.Width = (Application.Width * PointsToPixels) - PopupGap * 2
.Height = (Application.Height * PointsToPixels) - PopupGap * 2
.Toolbar = False
.StatusBar = False
.MenuBar = False
.Navigate strLink
.Visible = True
End With
Exit Sub
Else
'Auto mode - opens the web page, selects the attachment and opens
With IE
.Left = (Application.Left * PointsToPixels) + PopupGap
.Top = (Application.Top * PointsToPixels) + PopupGap
.Width = (Application.Width * PointsToPixels) - PopupGap * 2
.Height = 150
.Toolbar = False
.StatusBar = False
.MenuBar = False
.Navigate strLink
.Visible = True
End With
'just loads a simple modeless progress bar stating 'Locating File'
Load frm_ProgressBar
frm_ProgressBar.Show vbModeless
Application.ScreenUpdating = False
' Loop until the page is fully loaded
Timeout = Now + TimeValue("00:00:20") '-- wait maximum of 20 seconds
Do While IE.readystate <> 4 Or IE.Busy: DoEvents
Sleep 250 '--limit loop to reduce CPU load
If Now > Timeout Then GoTo ErrPageLoad
Loop
'This is the textbox, loop through values until the attachment name is found and select
With IE.document.ALL("ctl00_ContentPlaceHolder1_lstAttach")
For i = 0 To .Options.length
If InStr(1, .Options(i).Text, SelectedAttachment, 1) <> 0 Then
.Options(i).Selected = True
.Value = .Options(i).Value
Exit For
End If
Next i
If .Value = "" Then GoTo ErrFileDownload
End With
'Click on the button that downloads the attachment
IE.Navigate "javascript:__doPostBack('ctl00$ContentPlaceHolder1$btnShow','')"
'''''Alternative code, can use click function below which runs the above javascript
'IE.document.all("ctl00_ContentPlaceHolder1_btnShow").Click
DownloadComplete = False
FileDownloadClassicPopup = False
FileDownloadHandle = 0
IePopupBarHandle = 0
Sleep 600
'Check for both File Download window and the new type popup 'Frame Notification Bar' as found in IE8/9
Timeout = Now + TimeValue("00:00:20")
Do While DownloadComplete = False
IePopupBarHandle = FindWindowEx(IeHandle, 0, "Frame Notification Bar", vbNullString)
'probably don't need the line below as the above window should be fine
IePopupBarHandle = FindWindowEx(IePopupBarHandle, 0, "DirectUIHWND", vbNullString)
If IePopupBarHandle <> 0 And IE.readystate = 4 Then
DownloadComplete = True
Else
FileDownloadHandle = FindWindow("#32770", "File Download")
If FileDownloadHandle <> 0 Then DownloadComplete = True: FileDownloadClassicPopup = True
End If
DoEvents
If Now > Timeout Then GoTo ErrFileDownload
Sleep 250
Loop
'Just updates my simple userform with 'File downloading' message
Call frm_ProgressBar.FillVars("Downloading file, please wait...")
'If the 'File Download' window appeared, click on the open button
If FileDownloadClassicPopup = True Then
'Find the child open button
OpenButtonHandle = FindWindowEx(FileDownloadHandle, 0, "Button", "&Open")
'Bring window in focus and Click the Open button
SetForegroundWindow (OpenButtonHandle)
Sleep 1000 'this sleep is required and 600 miiliseconds seems to be the minimum that works
SendMessage OpenButtonHandle, BM_CLICK, 0, 0
DoEvents
Else
'Take control of IE security banner - Newer versions of IE with popup bar
SetForegroundWindow (IeHandle)
Sleep 1000
SendKeys "%O", Wait:=True
DoEvents
End If
'the file should now be opening
Application.Wait Now + TimeValue("00:00:02")
Unload frm_ProgressBar
Application.ScreenUpdating = True
'Quit IE
If ThisWorkbook.Sheets(shtRef).Range("Ref_CloseSpiceWeb") = "Y" Then
On Error Resume Next
IE.Quit
IE = Nothing
On Error GoTo 0
End If
End If
Exit Sub
ErrPageLoad:
Unload frm_ProgressBar
On Error Resume Next
IE.Quit
IE = Nothing
On Error GoTo 0
MsgBox "The web page isn't loading, please try again!", vbOKOnly, "Web error"
Exit Sub
ErrFileDownload:
Unload frm_ProgressBar
On Error Resume Next
IE.Quit
IE = Nothing
On Error GoTo 0
MsgBox "The file could not be located/downloaded, please try again!", vbOKOnly, "Web error"
Exit Sub
End Sub[/VBA]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules