I'm trying to automate the process of stock prices and then verify those prices with a screenshot from Yahoo Finance and pasting in onto a excel sheet.
I have completed the first task of auto pulling adjusted closing stock prices but I need the last step of verifying said prices by automating the process of going to yahoo finance and taking a screenshot of the price that day. The script I have so far succeeds with pulling the website up on internet explorer it even takes a screen shot of the window as well and pastes it but it does it incorrectly.
Issues:
1) Pastes about five screenshots when I only need one.
2) does not wait for the window to fully load before taking said screenshot.
3) I also want to just take a small part of the page.
Extra info: I am using two monitors
What I want:
What happens:
Option Explicit
Private Const SW_SHOWMAXIMIZED = 3
'Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const VK_SNAPSHOT = &H2C
Sub Screenshot()
Dim IEapp As Object
Dim WebUrl As String
'Delcaring internet explorer as web application
Set IEapp = CreateObject("InternetExplorer.Application")
WebUrl = "https://finance.yahoo.com/quote/TWLO/history?p=TWLO"
With IEapp
.Silent = True 'No Pop-ups
.Visible = True 'Set InternetExplorer to Visible
.Navigate WebUrl 'Load web page
Do While .busy
DoEvents
keybd_event VK_SNAPSHOT, 1, 0, 0
ActiveSheet.Paste
Loop
End With
End Sub
Thank you in advance!
Here you are using snapshot inside do while loop it will perform action until its ready state is complete
While .Busy Or .ReadyState <> 4: DoEvents: Wend
keybd_event VK_SNAPSHOT, 1, 0, 0
ActiveSheet.Paste
you have mentioned need to get small part of page please explain further
Related
I am looking for below code to covert from internet Explorer to Edge browser, request for you help to sort the same.
Sub CHECK_STATUS()
Dim cell As Range
Dim IntExp As Object
Set IntExp = CreateObject("InternetExplorer.Application")
IntExp.Visible = False
For Each cell In Range("A2:A20000")
'Here A2 is cell Address where we have stored urls which we need to test.
If Left(cell.Value, 4) = "http" Then
' Goto web page
IntExp.navigate cell.Text
' Below loop will run until page is fully loaded
Do While IntExp.Busy Or IntExp.readyState <> 4
DoEvents
Loop
' Now use text which you want to search , error text which you want to compare etc.
Dim ieDoc As Object
Set ieDoc = IntExp.document
If ieDoc.getElementsByClassName("box-content").Length <> 0 Then
cell.Offset(, 1).Value = ieDoc.getElementsByClassName("box-content")(0).innerText
End If
End If
Next cell
IntExp.Quit
Set IntExp = Nothing
End Sub
You need to use SeleniumBasic to automate Edge in VBA. SeleniumBasic is a Selenium based browser automation framework for VB.Net, VBA and VBScript.
I agree with QHarr's comments, you can also follow the steps below to automate Edge browser with SeleniumBasic:
Download the latest version of SeleniumBasic v2.0.9.0 from this link and install it.
Download the corresponding version of Edge WebDriver from this link.
Find the path of SeleniumBasic which is C:\Users\%username%\AppData\Local\SeleniumBasic in my computer (it might also be in this path C:\Program Files\SeleniumBasic), copy the Edge WebDriver msedgedriver.exe to this path.
Rename msedgedriver.exe to edgedriver.exe.
Open Excel and write the VBA code.
In the VBA code interface, click Tools > References, add Selenium Type Library reference and click OK to save.
I write a simple VBA code to show how to automate Edge using SeleniumBasic. You can refer to it and change the code according to your own demands:
Public Sub Selenium()
For Each cell In Range("A2:A20000")
Dim bot As New WebDriver
If Left(cell.Value, 4) = "http" Then
bot.Start "edge", cell.Value
bot.Get "/"
If Not bot.FindElementsByClass("box-content") Is Nothing Then
cell.Offset(, 1).Value = bot.FindElementsByClass("box-content")(1).Text
End If
End If
bot.Wait 3000
bot.Quit
Next cell
End Sub
I had been using IE and Internet Object Model (IOM) to achieve automation with internal web-based systems in my works at bank. Since the announcement that IE will be no longer supported by Microsoft at 15 June 2022, I started to look for possible alternative solutions on the internet.
After investigation, I found that there are two solutions to achieve automation on Edge browser : 1) SeleniumBasic or 2) Win API. Though SelenimBasic seems to be the mainstream suggestion at forums, Win API can be regarded as better solution in several different ways, especially for my own situations.
Pros of Win API Solution :
No need installation and regular update of Edge driver.
Able to automate with multiple existing Edge browser windows (which have been opened before program start).
Most of codes in existing IOM solution can be preserved and re-applied. It is because both solutions of IOM and Win API should use HTML Document Object Model (DOM) at last to achieve automation on webpage. The difference is on the way to find browser and attain HTMLDocument from browser.
Cons of Win API Solution :
We can automate with “webpage” on Edge browser but not the “Edge browser” itself. It is not like IOM and SeleniumBasic that can control web browser. For this, I use Shell function and DOS commands to achieve automation of opening and closing Edge browser.
The webpage has to be opened in IE mode at Edge browser which means this solution is subject to Microsoft’s future direction on IE mode of Edge browser.
Sharing on my experiences to use Win API on Edge browser webpage automation :
Place the following codes in a new blank module. I name this module as “MsEdge” usually. The codes in this module are no need to modify for usage. You can directly use the codes even if you don’t know much about Win API.
Public lngProcessID_Close As Long
'Part 1 --- Locate IES
Private strHwndIES As String
Private lngHwndIndex As Long
Private Declare Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" ( _
ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'Part 2 --- Get HTMLDocument from IES
Private Const SMTO_ABORTIFHUNG = &H2
Private Const GUID_IHTMLDocument2 = "{332C4425-26CB-11D0-B483-00C04FD90119}"
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" ( _
ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" ( _
ByVal hWnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
lParam As Any, _
ByVal fuFlags As Long, _
ByVal uTimeout As Long, _
lpdwResult As Long) As Long
Private Declare Function IIDFromString Lib "ole32" ( _
lpsz As Any, lpiid As Any) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" ( _
ByVal lResult As Long, _
riid As Any, _
ByVal wParam As Long, _
ppvObject As Any) As Long
'Part 3 --- Check Process Name
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Function findEdgeDOM(Title As String, URL As String) As Object
'Find criteria-hitting Edge page in IE mode
Dim hwndIES As Long
Do
hwndIES = enumHwndIES
If hwndIES Then
Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)
If Not findEdgeDOM Is Nothing Then
If InStr(findEdgeDOM.Title, Title) * InStr(findEdgeDOM.URL, URL) Then
Do
hwndIES = enumHwndIES
Loop While hwndIES
Exit Function
Else
Set findEdgeDOM = Nothing
End If
End If
End If
Loop While hwndIES
End Function
Public Function enumHwndIES() As Long
'Get all hwnds of IES
If Len(strHwndIES) = 0 Then
EnumWindows AddressOf EnumWindowsProc, 0
lngHwndIndex = 0
End If
'Exit function when overflow
If lngHwndIndex + 1 > (Len(strHwndIES) - Len(Replace(strHwndIES, ",", ""))) Then
enumHwndIES = 0
strHwndIES = ""
Exit Function
End If
'Return IES hwnd one by one
enumHwndIES = CLng(Split(Left(strHwndIES, Len(strHwndIES) - 1), ",")(lngHwndIndex))
lngHwndIndex = lngHwndIndex + 1
End Function
Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim lngProcessID As Long
GetWindowThreadProcessId hWnd, lngProcessID
EnumChildWindows hWnd, AddressOf EnumChildProc, lngProcessID
EnumWindowsProc = True
End Function
Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim strTargetClass As String, strClassName As String
strTargetClass = "Internet Explorer_Server"
strClassName = getClass(hWnd)
If strClassName = strTargetClass Then
If GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process WHERE ProcessId='" & lParam & "' AND Name='msedge.exe'").Count Then
strHwndIES = strHwndIES & hWnd & ","
lngProcessID_Close = lParam
EnumChildProc = False
Exit Function
End If
End If
EnumChildProc = True
End Function
Private Function getClass(hWnd As Long) As String
Dim strClassName As String
Dim lngRetLen As Long
strClassName = Space(255)
lngRetLen = GetClassName(hWnd, strClassName, Len(strClassName))
getClass = Left(strClassName, lngRetLen)
End Function
Public Function getHTMLDocumentFromIES(ByVal hWnd As Long) As Object
Dim iid(0 To 3) As Long
Dim lMsg As Long, lRes As Long
lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
SendMessageTimeout hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes
If lRes Then
IIDFromString StrPtr(GUID_IHTMLDocument2), iid(0)
ObjectFromLresult lRes, iid(0), 0, getHTMLDocumentFromIES
End If
End Function
Public Sub closeEdge(Title As String, URL As String)
'Close a Edge browser (the last one in EnumWindows order) with criteria-hitting webpage
lngProcessID_Close = 0
Dim findEdgeDOM As Object
Dim hwndIES As Long
Do
hwndIES = enumHwndIES
If hwndIES Then
Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)
If InStr(findEdgeDOM.Title, Title) * InStr(findEdgeDOM.URL, URL) Then
Shell "TaskKill /pid " & lngProcessID_Close
Do
hwndIES = enumHwndIES
Loop While hwndIES
Exit Sub
End If
End If
Loop While hwndIES
End Sub
Apply the functions in “MsEdge” module. There are a few application examples for you. Suggest to place and test below codes at another module:
Sub findEdgeDOM_DemoProc()
'Demo Proc : Use findEdgeDOM Function to get DOM of specific Edge webpage by Title AND URL
'Dim docHTML As MSHTML.HTMLDocument '--- Early Binding
Dim docHTML As Object '--- Late Binding
Set docHTML = findEdgeDOM("Enter Part of Webpage Title Here", "Enter Part of Webpage URL Here")
‘You can fill just one argument with either part of webpage title or URL as keyword to search for the target browser and leave another one blank (“”). If you provide both title and URL, the funcitons return DOM of the only browser that meets both criteria.
If Not docHTML Is Nothing Then Debug.Print docHTML.Title, docHTML.URL
End Sub
Sub goEdge()
'Go through every Edge webpage (opened in IE mode) and print out hwndIES, webpage Title & webpage URL
Dim hwndIES As Long
'Dim docHTML As MSHTML.HTMLDocument '--- Early Binding
Dim docHTML As Object '--- Late Binding
Do
hwndIES = enumHwndIES
If hwndIES Then
Set docHTML = getHTMLDocumentFromIES(hwndIES)
Debug.Print hwndIES, docHTML.Title, docHTML.URL
Else
Debug.Print "Procedure End"
End If
Loop While hwndIES
End Sub
Sub openEdgeByURL_DemoProc()
'Open Edge browser to specific URL
openEdgeByURL "Input Webpage URL Here"
End Sub
Public Sub openEdgeByURL(URL As String)
'Please change the path to your msedge.exe location in your PC
Shell "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe -url " & URL, vbNormalFocus
End Sub
Sub closeEdge_DemoProc()
'Close Edge browser
closeEdge "Enter Part of Webpage Title Here", "Enter Part of Webpage URL Here"
End Sub
Using a full heavy-weight web browser to do HTTP requests was probably a mistake in the first place, and now is a good opportunity to correct it.
Here is a stackoverflow question on how to do HTTP requests from Excel: it works the same in VBS.
getHTTP with (Excel) VBA?
I have a working VBA macro which enters SAP, starts a transaction and then extracts the data in spreadsheet.
But sometimes the calculation runs too long, or I just would like to stop it to intervene. There is a functionality on the toolbar at the top left corner, where the user can "stop transaction" manually.
Is there any SAP script code for the "stop transaction" button, so I can avoid the manual step?
SAP toolbar:
It is assumed that the VBA macro is running in the first session. If a second session is opened before starting the macro, it can be used to close the first session.
for example:
Set SapGuiAuto = GetObject("SAPGUI")
Set SAPapp = SapGuiAuto.GetScriptingEngine
Set SAPconnection = SAPapp.Children(0)
Set session = SAPconnection.Children(1)
session.findById("wnd[0]/tbar[0]/okcd").text = "/i1"
session.findById("wnd[0]").sendVKey 0
session.createSession
Application.Wait (Now + TimeValue("0:00:05"))
session.findById("wnd[0]/tbar[0]/okcd").text = "/i3"
session.findById("wnd[0]").sendVKey 0
session.createSession
Application.Wait (Now + TimeValue("0:00:05"))
Whether a "rollback" is carried out or not, would be to test.
Regards,
ScriptMan
I guess you better record a script with this scenario, then you can re-use it any time.
Otherwise, I am at the very moment struggling with the same case, but with the run time counter part to leave the tcode if running too long.
It is a hart nut to crack too, but a different topic.
Update: realizing that there is no way to get the 'Stop Transaction' step recorded, I applied the above method - thank you Script Man, it was not the first time you saved the day.
For anyone reading this thread - may be useful to know how to split the SAP runtime from VBA script runtime.
I introduced an object that is the 'Execute' command itself. This way, SAP takes the command and starts execution, while the macro will step over as it is not an actual command but applying a new object only. This trick can help users to write a time counter and drop the session if running too long.
For reference, see my code here - I quoted the part of my code that contains the relevant method.
'check whether you already have an extra session open to close the long running session
'open one if needed
On Error Resume Next
Set session1 = Connection.Children(1)
If Err.Number <> 0 Then
session.CreateSession
Application.Wait (Now + TimeValue("0:00:05"))
're-set the sessions, ensuring you use the first session for actual work and keep session1 in background
Set session = Connection.Children(0)
Set session1 = Connection.Children(1)
SesCount = Connection.Sessions.Count()
Err.Clear
On Error GoTo 0
End If
'get the ID of first session, so you can enter the correct terminating transaction code when needed
sessionID = Mid(session.ID, (InStrRev(session.ID, "[") + 1), 1)
Terminator = "/i" & sessionID + 1
session.FindById("wnd[0]").Maximize
'some code comes here
'here I use an object to apply the execute button - this way parallel with the SAP runtime, the VBA script can proceed.
perec = session.FindById("wnd[0]/tbar[1]/btn[8]").press
'here we set a loop to check whether system is busy over a certain time then we may interrupt:
Do
Application.Wait (Now + TimeValue("0:00:05"))
SecondsElapsed = SecondsElapsed + 5
fityirc = session.Busy()
if fityirc = False then
exit Do
end if
Loop Until SecondsElapsed >= 100
If fityirc = True Then
session1.FindById("wnd[0]/tbar[0]/okcd").Text = Terminator
session1.FindById("wnd[0]").sendVKey 0
End If
'...and so on. This solution is applied in a loop to extract datasets massively without human interaction.
Or, have a look at code I've just written and tested to use the Windows API to run the Stop Transaction menu item. I raised a question about it on the SAP forum, but figured it out myself in the meantime (SAP Forum)
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As LongPtr, ByVal bRevert As Long) As LongPtr
Private Declare PtrSafe Function GetMenuItemCount Lib "user32" (ByVal hMenu As LongPtr) As Long
Private Declare PtrSafe Function GetMenuItemInfoA Lib "user32" (ByVal hMenu As LongPtr, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Public Const MIIM_STRING As Integer = &H40
Public Const MIIM_ID = &H2
Public Const WM_COMMAND = &H111
Public Const WM_SYSCOMMAND = &H112
Public Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As LongPtr
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Public Function RunMenuItemByString(ByVal sMenuItem As String, _
ByVal sWindowClass As String, _
ByVal sWindowText As String, _
ByVal iCommandType As Integer) As Boolean
Dim hWnd As LongPtr, hMenu As LongPtr, lpMenuItemID As LongPtr
Dim lngMenuItemCount As Long, lngMenuItem As Long, lngResultMenuItemInfo As Long
Dim typMI As MENUITEMINFO
Dim s As String
Dim blnRet As Boolean
hWnd = FindWindowA(sWindowClass, sWindowText)
hMenu = GetSystemMenu(hWnd, 0&)
lngMenuItemCount = GetMenuItemCount(hMenu)
For lngMenuItem = 0 To lngMenuItemCount - 1
typMI.cbSize = Len(typMI)
typMI.dwTypeData = String$(255, " ")
typMI.cch = Len(typMI.dwTypeData)
typMI.fMask = MIIM_STRING Or MIIM_ID
lngResultMenuItemInfo = GetMenuItemInfoA(hMenu, lngMenuItem, 1, typMI)
s = Trim$(typMI.dwTypeData)
lpMenuItemID = typMI.wID
If InStr(1, s, sMenuItem, vbTextCompare) > 0 Then
blnRet = SendMessageA(hWnd, iCommandType, lpMenuItemID, 0&) = 0
Exit For
End If
Next lngMenuItem
RunMenuItemByString = blnRet
End Function
Public Function TestRunMenuItemByString()
lpHwndSAPSession = oSAPSession.FindById("wnd[0]").Handle
sWindowText = GetWindowText(lpHwndSAPSession)
TestRunMenuItemByString = RunMenuItemByString("Stop Transaction", "SAP_FRONTEND_SESSION", sWindowText, WM_SYSCOMMAND)
End Function
The TestRunMenuItemByString function can be used only after a session is started, and will only work if there is actually a transaction executing. You will need to figure out how to reference your sap session object (oSAPSession) in order to use the Handle value from it.
The declarations should work in both 32 bit and 64 bit versions of VBA and the LongPtr has been used for the handle (h) and pointer (lp) variables to reflect this.
This was tested in Microsoft Access, but I see no reason why it shouldn't work in VBA in other Office applications. I can't vouch for it being adaptable for VBScript.
Method:
I'm using a combination of SendKeys & Virtual Keyboard to send key strokes to a core administration system that is stored on Citrix as an application. The VBA code is identifying the application by using the AppActivate & Application.ActiveWindow methods.
Goal:
My goal is to have an user to input data into an excel spreadsheet and send the data to the core administration system using VBA in lieu of the user manually keying.
Problem:
My problems are many, but as of right now, I'm struggling to send Ctrl + f to the core administration system application. It doesn't seem to recognize the stroke, however, sending f alone or enter "keybd_event VK_RETURN, mvk, 0, 0" seems to work. Also, "keybd_event VK_CONTROL, mvk, 0, 0" seemed promising but I get an "Overflow" error when ran.
Code (So Far):
Option Explicit
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte,
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare PtrSafe Function MapVirtualKey Lib "user32" Alias "
MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Const VK_RETURN = &HD
Private Const VK_CONTROL = &HD11
Private Const KEYEVENTF_KEYUP = &H2
Sub pleasework5()
Dim keys As String
Dim wsh As Object
Dim mvk As Double
Set wsh = CreateObject("WScript.Shell")
mvk = MapVirtualKey(VK_RETURN, 0)
AppActivate ("application name") 'use form to enter username
Application.ActiveWindow.Activate
Application.Wait Now() + TimeValue("00:00:05")
'keybd_event VK_CONTROL, mvk, 0, 0
wsh.SendKeys ("^f"), True
Please let me know how to send Ctrl + f to the system application or if there's a better method of going about this.
Thank you!
I hope you've found the solution by now. However, here's what I do to send Ctrl + L
SendKeys "(^l)"
Hope that helps
I've seen similar questions asked before but there has never been a clear solution. I'm trying to bring the Excel window into focus in the foreground without closing Internet Explorer and it works perfectly fine in Debug mode but not when actually running it. I've tried AppActivate "Excel" already but that just makes the Excel icon at the bottom of the screen blink. Then I found this but I can't get it working
Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" _
(ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
Global Const SW_MAXIMIZE = 3
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Public Declare PtrSafe Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
Sub qstn()
Dim IE As New InternetExplorer: IE.navigate "www.cnn.com": IE.Visible = True: apiShowWindow IE.hWnd, SW_MAXIMIZE
LoadIt IE
SetForegroundWindow Application.hWnd
End Sub
Sub LoadIt(ByVal IE As InternetExplorer, Optional ByVal loadmins As Integer = 5)
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE And IE.Busy = False
End Sub
Try this
sub test()
AppActivate "Microsoft Excel"
End Sub
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