I'm looping through a list of csv files from a website which I want to open and extract the data from. The reason I'm using VBA is because the specific files I need to open varies day per day, and those specific file references is available only in an excel view. The second reason is because I've already made a similar scraping application in vba, so I already had half the code.
The end user of the application doesn't need clean or fast code, just that it works, because checking these files manually now is a daily chore of 2 hours per day.
So far I'm already logged into the website where the secondairy files are stored (This website has no API so I'm scraping it) and I'm opening those files by letting the code click the buttons. The code then clicks the export button, which opens the dialog box to
open, save (dropdown), cancel
I just want to open and extract the data then close, so I'm using the code from VBA Internet Explorer Automation - How to Select "Open" When Downloading a File . It feels like my code is bugging on this part...
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
Dim ie As InternetExplorer
Dim h As LongPtr
Function Download()
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Set o = New CUIAutomation
h = ie.Hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Function
Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Open")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
End Function
before I invoke this function I check the amount of workbooks and make excel wait upto 20 seconds until another workbook is opened. I do that with this code
xnum1 = Application.Workbooks.Count
Download
t = Now
tStop = t + TimeValue("00:00:20") 'Adjust the TimeValue as needed "hh:mm:ss"
Do Until t = tStop Or Application.Workbooks.Count > xnuml
DoEvents
t = Now
Loop
However it seems that even with this wait time, excel doesn't want to open the file during every loop. If I run it step by step, it does open the file, when I let it run on it's own, it doesn't.
After I downloaded the file I export the data to the main file and then close it, using Application.DisplayAlerts to ensure no dialog box prevents the closing of the file. But because the code bugs in the download I've had instances where the file opened too late and then it didn't close, and because they all have the same filename I made an extra safegaurd in the main code:
xnum1 = Application.Workbooks.Count
For y = 1 To xnum1
If Left(Application.Workbooks(y).Name, 10) = "export.csv" Then
Application.Workbooks(y).Close
End If
Next
I can't seem to figure out why excel isn't opening the files properly and then closing them properly... Seems like the code just runs, goes into error mode because the file didn't open in the second run, although no error is given by the code itself even when I step through it.
My gut is telling me that this Download function is where the problem lies, but I can't point out how to fix it...
I've also tried with sendkeys %{O}, the shortkey to click open, but this also didn't open the file. When I manually click alt + O it does open the file...
Any suggestions?
Related
Suppose I have two hyperlinks (on excel sheet) referring to two documents:
e.g ( A.doc and B.doc ) on my local intranet.
I will open the first document "A.doc" then I will open the second one "B.doc"
The problem:
If there is already an opened word document and then I clicked hyperlink (Word Document on my local intranet),
The later file is not opened automatically and I have to click on the flashing taskbar button to open the cited second file.
This issue occurs only with Microsoft word documents found on my local intranet.
If there is no open document and I clicked on any word hyperlink, It opens normally without any issue.
Please watch this short video to understand my problem.
I need to utilize FollowHyperlink event in excel or any other method to:
bring the previous opened window A.doc to front and then bring the second one B.doc to front.
you may find it a strange question! But I have to do it manually each time to show and bring the second one to front.
I have used this API code (in a Word document) on Normal-ThisDocument:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Dim LHwnd As Long
Private Sub Document_Open()
If Application.Documents.Count > 1 Then
LHwnd = FindWindow("rctrl_renwnd32", Application.ActiveWindow.Caption)
SetForegroundWindow (LHwnd)
End If
End Sub
And used that code on my excel sheet itself:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error Resume Next
Dim objWd As Object
Set objWd = GetObject(, "Word.Application")
AppActivate objWd.ActiveWindow.Caption
Set objWd = Nothing
End Sub
Finally, I found this helpful page Bring an external application window to the foreground But I could not adapted it to my need.
Please, try the next BeforeDoubleClick event. If the problem is related only to hyperlinks, it should work...
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.column = 1 And Target.Value <> "" Then 'limit this behavior to the first column
If LCase(left(Target.Value, 5)) = "http:" Then
Cancel = True
Dim objWd As Object, d As Object, arrD: arrD = Split(Target.Value, ".")
If LCase(left(arrD(UBound(arrD)), 3)) <> "doc" Then Exit Sub
On Error Resume Next
Set objWd = GetObject(, "Word.Application") 'find the Word open session, if any
On Error GoTo 0
If objWd Is Nothing Then
Set objWd = CreateObject("Word.Application")
End If
With objWd
.Visible = True
Set d = .Documents.Open(Target.Value)
End With
'force somehow the new open document window expose its handler...
Dim i As Long
Do Until objWd.ActiveWindow.Caption = d.name Or _
objWd.ActiveWindow.Caption = left(d.name, InstRev(d.name, ".")-1) & " [Read-Only] [Compatibility Mode]"
i = i + 1: Debug.Print objWd.ActiveWindow.Caption, left(d.name, InstRev(d.name, ".")-1) & " [Read-Only] [Compatibility Mode]"
DoEvents: If i >= 10 Then Exit Do 'just in case, if something unexpected happens...
Loop
SetForegroundWindow CLngPtr(objWd.ActiveWindow.hWnd)
End If
End If
End Sub
It should work in 64 bit, but it is easy to be adapted for both cases, supposing that it works as you need.
I am very new to Stack Overflow & VBA so please pardon me for any mistakes in my question.
We are trying to download a table into a .txt file from the SAP GUI interface using scripting
Whenever we try to run the code we get the error "the control could not be found by id".
The button which we are trying to press
Things we tried:
We tried using Send keys but we are not very confident on it. It will be our last resort.
When we used FindAllByName with "shell" it clicks the "Export" button on the table below it
From what I can understand
The numbers (Italized or marked with ** in code) in the script keep changing. So we guess there is a clash between the stored script number in SAP and in the excel from which we are trying to run
The Table which we are trying to interact only appears when we load sum part numbers and hit "Go". It wont appear when we initially open the GUI.
Public Declare Function SetForegroundWindow _
Lib "user32" (ByVal hwnd As Long) As Long
Sub SA_Dump()
Dim App, Connection, session As Object
Set SapGuiAuto = GetObject("SAPGUI")
Dim setFocus As Long
Set App = SapGuiAuto.GetScriptingEngine
Set Connection = App.Children(0)
Set session = Connection.Children(0)
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
Dim sCestaGrid As String
Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Copy
setFocus = session.ActiveWindow.Handle
SetForegroundWindow setFocus
Application.Wait (Now + TimeValue("0:00:05"))
'Reset fields
session.findById("wnd[0]").resizeWorkingPane 147, 25, False
session.findById("wnd[0]/usr/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1005/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1001/btnRESETSIMPLESEL").press
'hit selection window
session.findById("wnd[0]/usr/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1005/subSUB02:/SCF/SG/CA_110SPPDRPSB1:1002/btnSGNT_0000034-MATNR_V").press
'hit copy from clipboard
session.findById("wnd[1]/tbar[0]/btn[24]").press
'hit Check entries mark
session.findById("wnd[1]/tbar[0]/btn[0]").press
'hit Copy button
session.findById("wnd[1]/tbar[0]/btn[8]").press
'hit Go button
session.findById("wnd[0]/usr/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1005/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1001/btnBUTTON01").press
'Clear clipboard to avoid pop-up at end to close Excel sheets
Application.CutCopyMode = False
'hit export (ERROR HAPPENS HERE!!!)
session.findById("wnd[0]/usr/subSUB02:/SCF/SG/CA_110SPPDRPSB1:*2119*/subSUB03:/SCF/SG/CA_110SPPDRPSB1:*2141*/cntlCONTAINER_7/shellcont/shell").pressToolbarContextButton "&MB_EXPORT"
session.findById("wnd[0]/usr/subSUB02:/SCF/SG/CA_110SPPDRPSB1:*2119*/subSUB03:/SCF/SG/CA_110SPPDRPSB1:*2141*/cntlCONTAINER_7/shellcont/shell").selectContextMenuItem "&PC"
'hit Tick button
session.findById("wnd[1]/tbar[0]/btn[0]").press
'For rename
session.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "Rel_mvmnt.txt"
session.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 10
'Hit replace button
session.findById("wnd[1]/tbar[0]/btn[11]").press
End Sub
I use this way and it works:
session.findById("wnd[0]/tbar[0]/okcd").text = "%pc"
Let me know if it worked for you.
I understand "Environ" can identify who opens the file, but I do not know how to write the code for it.
I found one answer that emails via Outlook when a file is opened, but ideally it would be logged with the person's name and time stamped in a hidden tab in the worksheet or some other file. Since the user will not be making edits to the file and/or saving it I don't know if that is an option.
Here's some code you can use. Open VBE (Alt+F11) double click on the "ThisWorkbook" over in the Project window for your spreadsheet and then paste this in.
Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Workbook_Open()
'When the worksheet opens, this will write the computer username
' and the date and time to a worksheet of your choice
' just change that "YourHiddenSheetNameHere" to the name of your
' hidden tab
Dim lastRow As Integer
Dim hiddenSheet As Worksheet
Set hiddenSheet = Sheets("YourHiddenSheetNAmeHere")
lastRow = hiddenSheet.Range("A999999").End(xlUp).Row
hiddenSheet.Cells(lastRow, 1).Value = ReturnUserName
hiddenSheet.Cells(lastRow, 1).Value = Now()
End Function
Function ReturnUserName() As String
' returns the NT Domain User Name
Dim rString As String * 255, sLen As Long, tString As String
tString = ""
On Error Resume Next
sLen = GetUserName(rString, 255)
sLen = InStr(1, rString, Chr(0))
If sLen > 0 Then
tString = Left(rString, sLen - 1)
Else
tString = rString
End If
On Error GoTo 0
ReturnUserName = UCase(Trim(tString))
End Function
This will fire every time someone opens the workbook saving the username they used to log into the computer as well as the date and time. Saving to whichever tab you stick in there. You'll need to save the workbook with .xlsm instead of .xlsx since it will be a macro-enabled book.
I have seen a lot of suggestions for this problem, and I have tried them all, but none seem to work. The VBA code is in a non-Microsoft product (SAP Business Objects, which might be the problem). I create an Excel object:
Set oExcel = CreateObject("Excel.Application")
Load the contents from column 1 of one of the WorkSheets in a particular workbook, then close Excel. Each time, it leaves a process in memory, taking up 5+ mb of memory.
I tried making the oExcel object visible, so that at least I could kill it without resorting to the Task Manager, but when I call Quit, the UI quits, and still leaves the process.
Every time I run the code, it creates a new process. So I tried to reuse any existing Excel processes by calling
Set m_oExcel = GetObject(, "Excel.Application")
and only creating it if that call returns nothing,
That did not proliferate the processes, but the single process grew by 5+ mb each time, so essentially the same problem.
In each case, I close the workbook I opened and set DisplayAlerts to False before quitting:
m_oBook.Close SaveChanges:=False
m_oExcel.DisplayAlerts = False
m_oExcel.Quit
This bit of code has been in use for at least five years, but this problem did not crop up until we moved to Windows 7.
Here is the full code in case it helps. Note all the Excel objects are module level variables ("m_" prefix) per one suggestion, and I have used the "one-dot" rule per another suggestion. I also tried using generic objects (i.e. late bound) but that did not resolve the problem either:
Private Function GetVariablesFromXLS(ByVal sFile As String) As Boolean
On Error GoTo SubError
If Dir(sFile) = "" Then
MsgBox "File '" & sFile & "' does not exist. " & _
"The Agent and Account lists have not been updated."
Else
Set m_oExcel = CreateObject("Excel.Application")
Set m_oBooks = m_oExcel.Workbooks
Set m_oBook = m_oBooks.Open(sFile)
ThisDocument.Variables("Agent(s)").Value = DelimitedList("Agents")
ThisDocument.Variables("Account(s)").Value = DelimitedList("Accounts")
End If
GetVariablesFromXLS = True
SubExit:
On Error GoTo ResumeNext
m_oBook.Close SaveChanges:=False
Set m_oBook = Nothing
Set m_oBooks = Nothing
m_oExcel.DisplayAlerts = False
m_oExcel.Quit
Set m_oExcel = Nothing
Exit Function
SubError:
MsgBox Err.Description
GetVariablesFromXLS = False
Resume SubExit
ResumeNext:
MsgBox Err.Description
GetVariablesFromXLS = False
Resume Next
End Function
Most times this happens because Excel is keeping a COM Add-in open. Try using the link below for help on removing the COM Add-in.
Add or remove add-ins
I find particular comfort in the note:
Note This removes the add-in from memory but keeps its name in the list of available add-ins. It does not delete the add-in from your computer.
Adding an answer based on David Zemens comment. Works for me.
m_oExcel.Quit '<- Still in Task Manager after this line
Set m_oExcel = Nothing '<- Gone after this line
This question has already been answered by Acantud in response to a subsequent post:
https://stackoverflow.com/questions/25147242
Fully qualify your references to objects within the Excel workbook you open to avoid creating orphaned processes in the task manager. In this case, the solution is to prefix DelimitedList with m_oBook, such as
ThisDocument.Variables("Agent(s)").Value = m_oBook.DelimitedList("Agents")
Though this isn't supposed to happen, you could send excel a "WindowClose" message in order to force close.
You'll be needing these API functions
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
And it should look something like this:
// First, get the handle
hWindow = FindWindow(vbNullString, "Excel")
//Get proccess ID
GetWindowThreadProcessId(hWindow, ProcessValueID)
//Kill the process
ProcessValue = OpenProcess(PROCESS_ALL_ACCESS, CLng(0), ProcessValueID)
TerminateProcess(ProcessValue, CLng(0))
CloseHandle ProcessValueID
Need to use only:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Excel.Application.Quit
End Sub
I am writing a macro to download a csv file from my company's internal website.
For many reasons I can't use any xmlhttp objects. The macro will download the file. The problem is Internet Explorer 9 prompts the user with Open, Save, and Cancel buttons.
While in IE, Alt+Shift+S will save the download, but I can't get the Sendkeys "%+s" method from Excel VBA to work.
Here is the relevant code:
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 "%+s", True
followLinkByText = True
Exit Function
End If
Next
End Function
Like I mentioned in my comments, The Info Security bar makes it difficult to interact with the File Download Window.
An alternative is to use the webbrowser control and then passing the URL to it. But the main problem with this method is that you cannot have the webbrowser in the same Excel Instance. Once the File Download window pops up your entire VBA Macro will come to a standstill till the time you do not dispose it off.
Here is an alternative. Here is a small exe that I created in VB6 which will pop up the File Download window bypassing the IE Info Security Bar. And once the File Download window pops up, you can interact with it using the APIs as shown in my blog article.
Let's take an example to see on how we interact with this vb6 exe file.
Create a module in Excel and paste this code.
IMPORTANT NOTE: Since you didn't give me any URL, I am taking a Static URL. Please replace it with your link. Now depending upon the link that you specify, you might see the one of these two download windows. Based on the download window that you see you will have to find the window handles based on the pic shown below. More details on the blog link that I gave.
Download the file attached and save it in say C:\. If you save it in any other location then amend that in the Shell statement below.
Sub Sample()
Dim sUrl As String
sUrl = "http://spreadsheetpage.com/downloads/xl/king-james-bible.xlsm"
Shell "C:\FDL.exe " & sUrl, vbNormalFocus
End Sub
SNAPSHOT
FILE: The file can be downloaded here.
You may try this as it is worked for me on IE 11:
Copy file C:\Windows\System32\UIAutomationCore.dll file to users Documents i.e C:\Users\admin\Documents then add reference UIAutomationClient to your macro file.
Paste below code in your module:
Option Explicit
Dim ie As InternetExplorer
Dim h As LongPtr
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 Download()
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Set o = New CUIAutomation
h = ie.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
End Sub
Try at your end.
I think I came up with a simpler solution: when the download bar appears in IE9, just by-pass it by displaying the "real" Download Pop Up window. The shortcut is "CTRL+J". All you have to do next is click on "Save" or "Open". There might be pretty ways to do it, but I simply send a key sequence to move the focus on desired option and then press enter.
Here is the code:
' Wait for download bar to appear
Application.Wait (Now + TimeValue("0:00:04"))
' Sending CTRL+J to open download pop-up
SendKeys "^j"
' Wait for download popup to appear
Application.Wait (Now + TimeValue("0:00:02"))
' Sending keys sequence to click on "Save" button
SendKeys "{RIGHT}{RIGHT}{RIGHT}~"
Your Application.Sendkeys just needs a tweak. Below is the code I am using so it is tested on IE11. This is for Alt+S with no Shift which is the keyboard shortcut in IE11. Let me know if this doesn't work and you need help adding the Shift back in.
Application.SendKeys "%{S}", True