First off, this is the sort of website I am trying to download files from (via clicking on "Download Data" with the CSV option on). The problematic code (I think; it's hard to tell, partially because it only occurs when running the code at full speed, not stepping through, and partially because the problem is inconsistent, in that it doesn't occur all the time), is this:
Option Explicit 'this stuff at the beginning, of course
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As LongPtr
Sub ContactWeb(ByVal URL As String)
Dim IE As InternetExplorer
'leaving these here so you can see what it is I'm working with right now
Dim Doc As Object, Elmt As Object
Dim HTMLColl As MSHTML.IHTMLElementCollection
Dim Handle As LongPtr
Dim CUI As IUIAutomation
Dim HandleElement As IUIAutomationElement
Dim Condition As IUIAutomationCondition
Dim Button As IUIAutomationElement
Dim InvokePattern As IUIAutomationInvokePattern
Set IE = New InternetExplorer
With IE
'code that loops through elements/clicks on csv and download data goes here
Set CUI = New CUIAutomation
'this point on just clicks "save" on the "do you want to open or save" bar
SetHandle:
Do
Handle = FindWindowEx(.Hwnd, 0, "Frame Notification Bar", vbNullString)
Loop While Handle = 0
If Handle = 0 Then 'just in case it somehow breaks out of that loop
.Visible = True
MsgBox "Could not download file; please do so manually."
Stop
GoTo SetHandle 'I really really *really* hate GoTo
'but I wasn't sure how to eliminate it in this case
End If
'this is the spot I think where it starts failing sometimes
'or at least, the above seems to work a lot more consistently
DoEvents 'if you try to go through this full tilt
'it will return "object variable or with block variable not set"
'so this slows it down a bit
Set HandleElement = CUI.ElementFromHandle(ByVal Handle)
DoEvents
Set Condition = CUI.CreatePropertyCondition(UIA_NamePropertyId, "Save")
DoEvents
Set Button = HandleElement.FindFirst(TreeScope_Subtree, Condition)
'this is the only part that actually requires IE to be visible
'(for reasons unknown to me)
DoEvents
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
DoEvents
InvokePattern.Invoke
.Quit
End With
End Sub
So as mentioned, this code always runs, but the file doesn't always appear...if I run it automatically. When I run it step by step, it always works like a charm (except for that one time it got stuck in an eternal loop - where I have a comment wondering if complete or interactive makes more sense). Can someone help me out here? Why is this happening?
Related
I am trying to download file using InternetExplorer.Application, but it always opens a window asking to save or open the file. Is there a way to circumvent this and have it run and save in the background? Here is a block of code I have tried.
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "https://pastebin.com/raw/terAweb"
State = 0
Do Until State = 4
DoEvents
State = ie.readyState
Loop
Dim file: file= ie.Document.Body.innerHTML
Using the URL Monikers API instead of trying to communicate with the InternetExplorer Application might be simpler.
Was that specifically done for Pastebin? Because it doesn’t really work with it, as far as I know. But I guess you can use another one 😉
Option Explicit
Private Declare PtrSafe Function URLDownloadToFileA Lib "URLMON" _
(ByVal pcaller As Long, _
ByVal szurl As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As LongPtr
Sub Example()
Dim Download$
On Error GoTo ErrorHandler
Download = URLDownloadToFileA(0, "myURL", "C:\Users\Name\Downloads\test.txt", 0, 0)
Exit Sub
ErrorHandler:
MsgBox Err.Number & " " & Err.Description
End Sub
Please refer to the following sample code, after using the getElementbyId method to find the download button, it will display the download prompt, we could using the Application.SendKeys "%{s}" command to click the Save button.
Sub downloadfile()
Dim IE As Object, Data As Object
Dim ticket As String
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate ("https://dillion132.github.io/default.html")
While IE.ReadyState <> 4
DoEvents
Wend
'Trigger the download button to download the file
IE.Document.getElementbyId("btnDowloadReport").Click
'wait the download prompt appear
Application.Wait (Now + TimeValue("00:00:03"))
'
Application.SendKeys "%{s}"
'Waiting for the site to load.
'loadingSite
End With
Set IE = Nothing
End Sub
The web page content:
<a id="btnDowloadReport" href="https://research.google.com/pubs/archive/44678.pdf" download>Download</a>
after a lot of research I couldn't find anyone with the same problem as me. So can any of the gurus please help me with my Excel Macro?
My macro does the following:
Open another excel workbook
Copy over the first sheet from this workbook to my current workbook
Create a button in the copied sheet
Write some code in this new created button
And here is the problem, when my macro writes the code in the button, it opens the VBA Code Editor and closes afterwards. My macro does it many times, so the VBA Code Editor keeps flashing during the macro run.
"Application.ScreenUpdating = False" didn't resolve the issue.
Please see below my code to do this Step 4 and let me know if you know a solution for that.
wb is my Workbook and ws my Worksheet
Set oOleObj = ws.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=5.4, Top:=4.8, Width:=97.2, Height:=35.4)
Set VBP = wb.VBProject
Set VBC = VBP.VBComponents(VBP.VBComponents.Count)
Set CM = VBC.CodeModule
With wb.VBProject.VBComponents(wb.Worksheets(ws.Name).CodeName).CodeModule
LineNum = .CreateEventProc("click", oOleObj.Name)
LineNum = LineNum + 1
.InsertLines LineNum, "UploadToAlmButton_OnClick"
End With
I could simple protect the project from viewing with a password. That should resolve the issue, but creates another one: If it's protected, I cannot write code on it by macro as I am doing in the Step 4. :(
Thanks!
To hide VBE window
Application.VBE.MainWindow.Visible = False
Application.VBE.MainWindow.Visible = True
If VBE window is still flickering then you need to use LockWindowUpdate Windows API function.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hWndLock As Long) As Long
Sub EliminateScreenFlicker()
Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If
'''''''''''''''''''''''''
' your code here
'''''''''''''''''''''''''
Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub
References:
Cpearson - Eliminating Screen Flicker During VBProject Code
MSDN- VBE flashes while programming in the VBE
I have a master macro in an Excel file, 'file A' that opens another Excel file, 'file B'. On open, an add-in imports data into 'file B'. I would like to close 'file B' once the add-in is finished importing, and I'm looking for the best way to do that.
I've written the code to open 'file B' (which triggers the add-in automatically) and to close the file, but when the add-in is finished, it opens a MsgBox to notify the user. I'm trying to completely automate an internal process, so dismissing the MsgBox programmatically would be ideal.
Is it possible to dismiss a MsgBox through VBA? I'm aware that I can create timed MsgBoxes in VBA but I'm not creating this MsgBox (the add-in is); I just want to dismiss it. I'm open to creating a Word file and calling a macro from that if required, but would prefer not to use SendKeys.
Since the "add-in" and Excel/VBA run in the same context, we cannot launch it and monitor its message-box within the same VBA application, because each VBA application is a single-threaded process. Fortunately however, there is a solution that can exploit the fact that different VBA applications run in different contexts, so they can run in parallel.
My suggested solution is to create a MS-Word document that is dedicated to monitoring and closing that message box. We need this in Word (or any other office application) in order to make the monitoring code and the addin's code run in parallel, in different contexts.
1- create a Word macro-enable document, named mboxKiller.docm and place it in some folder; i.e. C:\SO in my example. place this code in ThisDocument and save:
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Sub WaitAndKillWindow()
On Error Resume Next
Dim h As Long: h = FindWindow(vbNullString, "Microsoft Excel")
If h <> 0 Then SendMessage h, 16, 0, 0 ' <-- WM_Close
Application.OnTime Now + TimeSerial(0, 0, 1), "WaitAndKillWindow"
End Sub
Private Sub Document_Open()
WaitAndKillWindow
End Sub
2- In the Excel workbook's VBA, create a class module, named mboxKiller with this code:
Private killerDoc As Object
Private Sub Class_Initialize()
On Error Resume Next
Set killerDoc = CreateObject("Word.Application").Documents.Open(Filename:="C:\SO\mboxKiller.docm", ReadOnly:=True)
If Err.Number <> 0 Then
If Not killerDoc Is Nothing Then killerDoc.Close False
Set killerDoc = Nothing
MsgBox "could not lauch The mboxKiller killer. The message-box shall be closed manuallt by the user."
End If
End Sub
Private Sub Class_Terminate()
On Error Resume Next
If Not killerDoc Is Nothing Then killerDoc.Application.Quit False
End Sub
3- Testing and Usage. In a normal class Module, place the following code and test the procedure
Sub Test() ' <-- run this for testing after finishing the setup
Dim killer: Set killer = New mboxKiller
simulateAddin
simulateAddin
simulateAddin
End Sub
' Procedure supposed to do some calculation then display a message box
Private Sub simulateAddin()
Dim i As Long
For i = 0 To 1000: DoEvents: Next ' simulates some calculations
MsgBox "This is a message box to simulate the message box of the addin." & VbCrLf & _
"It will be automatically closed by the Word app mboxKiller"
End Sub
VBA also has the ability to temporarily dismiss alerts.
Application.DisplayAlerts = False
'while you run your code here, no alerts will be displayed
Application.DisplayAlerts = True
We need to download file from a NASDAQ website automatically. My existing VBA code is opening an IE "Do you want to Open/Save" dialogue window. How to click on that save button and give a path via VBA ?
I have tried various windows api methods described in this link here also but that is giving a result of "Window Not Found".
My current code is as below:
Sub MyIEauto()
Dim ieApp As InternetExplorer
Dim ieDoc As Object
'Dim ieTable As Object
'create a new instance of ie
Set ieApp = New InternetExplorer
'you don’t need this, but it’s good for debugging
ieApp.Visible = True
'assume we’re not logged in and just go directly to the login page
ieApp.Navigate "https://indexes.nasdaqomx.com/Account/LogOn"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.Document
'fill in the login form – View Source from your browser to get the control names
With ieDoc.forms(0)
.UserName.Value = "xxxxxxx"
.Password.Value = "xxxxxxx"
.submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
'now that we’re in, go to the page we want
ieApp.Navigate "https://indexes.nasdaqomx.com/Index/ExportWeightings/NDX?tradeDate=2015-08-19T00:00:00.000&timeOfDay=SOD/SODWeightings_2015"
'next below line commented as it is failing
'ieApp.ExecWB 4, 2, "D:\VBA code work\SODWeightings_20150819_NDX.xlsx"
set ieApp=Nothing
set ieDoc=Nothing
End Sub
The screenshot below shows where I have reached. How do I progress from here?
It's solved finally...
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Public Sub AddReference()
ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\SysWOW64\UIAutomationCore.dll"
End Sub
'after my original code as posted in question then this below lines
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Set o = New CUIAutomation
Dim h As Long
h = ieApp.hWnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
Another way to do this is to send the keystrokes of the shortcut keys to click the save button in IE11. I should note your IE window will need to be the active window for this to work. Thus, it won't work while in debug mode.
The code below calls the shortcut key. I'm just showing the shortcut key so you have a better idea what's happening.
Shortcut key:Alt+S
VBA: Application.SendKeys "%{S}"
as ieApp.hWnd in a 64bit environment is LongLong, where h is Long
this yields a Type Mismatch which can easily been solved by
h = Clng(ieApp.hWnd)
SendKeys was the solution for me.
myfile = "C:\Users\User\Downloads\myfile.xls"
checkmyfile = Dir(myfile, vbArchive)
Do While checkmyfile = ""
On Error Resume Next
checkmyfile = Dir(myfile , vbArchive)
If checkmyfile = "myfile.xls" Then Exit Do
AppActivate "Title - Internet Explorer"
SendKeys "%(g)"
Application.Wait Now + TimeValue("0:0:1")
Loop
I posted on IE 9 not accepting SendKeys to download a file, but this problem is separate enough from the answer I received to justify another question. My problem is that I can't get IE 9 to accept any of the SendKeys. I have attempted Page Down, Tab, all of the F# keys, and none of them work.
Here is the code I am using:
Dim ie As Object
'This creates the IE object
Sub initializeIE()
'call this subprocedure to start internet explorer up
Set ie = CreateObject("internetexplorer.application")
pos = 1
End Sub
'Initialize the class object
Private Sub Class_Initialize()
initializeIE
End Sub
Function followLinkByText(thetext As String) As Boolean
'clicks the first link that has the specified text
Dim alink As Variant
'Loops through every anchor in html document until specified text is found
' then clicks the link
For Each alink In ie.document.Links
If alink.innerHTML = thetext Then
alink.Click
'waitForLoad
Application.Wait Now + TimeValue("00:00:01")
Application.SendKeys "{PGDN}", True
Application.SendKeys "{PGUP}", True
'I've also tried calling it without Application before it
SendKeys "{F1}", True
SendKeys "{F2}", True
'Etc... Each of these not being received by IE 9
followLinkByText = True
Exit Function
End If
Next
End Function
I'm at a total loss because it seems like most forums or tutorials don't do anything different for IE 9. The IE object is created in a class module and initialized in the Class_Initialize sub. I am not sure if that helps any, but I really have no idea why this isn't working and any help on how to send keys to IE would be greatly appreciated.
This is actually a copy of my answer to this question, but it may still apply.
Is the IE window active when you try your SendKeys? If not, this would explain it not working.
To activate your window:
At the beginning of your module, put this line of code:
Public Declare Function SetForegroundWindow Lib "user32" (ByVal HWND As Long) As Long
This will allow you to access the SetForegroundWindow function built into Windows.
In your code, while interacting with your IE object, record the HWND for that window like so:
Dim HWNDSrc As Long
HWNDSrc = ie.HWND
Then after you've loaded the page, use this to continue, then send your key actions:
SetForegroundWindow HWNDSrc
However, this may not be necessary, depending on how you are interacting with IE. In other words, if you don't need to see/touch the window (you do for SendKeys), you can still interact using the object in code.
Now, I see you using Application.Wait after you click, but that does not guarantee the IE page has loaded. This function should help with that.
Public Sub WaitForIE(myIEwindow As InternetExplorer, HWND As Long, WaitTime As Integer)
' Add pauses/waits so that window action can actually
' begin AND finish before trying to read from myIEWindow.
' myIEWindow is the IE object currently in use
' HWND is the HWND for myIEWindow
' The above two variables are both used for redundancy/failsafe purposes.
' WaitTime is the amount of time (in seconds) to wait at each step below.
' This is variablized because some pages are known to take longer than
' others to load, and some pages with frames may be partially loaded,
' which can incorrectly return an READYSTATE_COMPLETE status, etc.
Dim OpenIETitle As SHDocVw.InternetExplorer
Application.Wait DateAdd("s", WaitTime, Now())
Do Until myIEwindow.ReadyState = READYSTATE_COMPLETE
' Wait until IE is done loading page and/or user actions are done.
Loop
Application.Wait DateAdd("s", WaitTime, Now())
While myIEwindow.Busy
DoEvents ' Wait until IE is done loading page and/or user actions are done.
Wend
On Error Resume Next
' Make sure our window still exists and was not closed for some reason...
For Each OpenIETitle In objShellWindows
If OpenIETitle.HWND = HWND Then
If Err.Number = 0 Then
Set myIEwindow = OpenIETitle
Exit For
Else
Err.Clear
End If
End If
Next OpenIETitle
On Error GoTo 0
End Sub
At the risk of being long-winded, I've updated your code with these suggestions...
' Added by Gaffi
Public Declare Function SetForegroundWindow Lib "user32" (ByVal HWND As Long) As Long
Dim HWNDSrc As Long
Dim ie As Object
'This creates the IE object
Sub initializeIE()
'call this subprocedure to start internet explorer up
Set ie = CreateObject("internetexplorer.application")
' Added by Gaffi
HWNDSrc = ie.HWND
pos = 1
End Sub
'Initialize the class object
Private Sub Class_Initialize()
initializeIE
End Sub
Function followLinkByText(thetext As String) As Boolean
'clicks the first link that has the specified text
Dim alink As Variant
'Loops through every anchor in html document until specified text is found
' then clicks the link
For Each alink In ie.document.Links
If alink.innerHTML = thetext Then
alink.Click
'waitForLoad
' Added by Gaffi
WaitForIE ie, HWNDSrc, 1
SetForegroundWindow HWNDSrc
'Application.Wait Now + TimeValue("00:00:01")
Application.SendKeys "{PGDN}", True
Application.SendKeys "{PGUP}", True
'I've also tried calling it without Application before it
SendKeys "{F1}", True
SendKeys "{F2}", True
'Etc... Each of these not being received by IE 9
followLinkByText = True
Exit Function
End If
Next
End Function