I have a question I am unable to find the answer to. I have a macro that imports data from a .MHTML file into my worksheet (Using the .MHTML file is my only option unfortunately. It is an export from SAP and opens in Excel but is not recognized as an Excel file due to file extension type.). At the end of the macro I wouuld like to close it. It is not recognized as an excel workbook so I am unable to use the simple: Workbooks().close command.
Does anyone have any ideas on how to do this? Thanks in advance.
I was able to find this code and after changing the Caption to match what is shown in Task Manager, it worked: http://www.vbforums.com/showthread.php?208430-Use-sendmessage-to-close-an-application
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_CLOSE = &H10
Sub ExportClose()
Dim CloseIt As Long
CloseIt = FindWindow(vbNullString, "Microsoft Excel - SAP_export.MHTML")
PostMessage CloseIt, WM_CLOSE, CLng(0), CLng(0)
End Sub
Note: This works great for my system but not for my colleague
.. Currently trying to figure out why
Maybe try just:
Windows("SAP_export.MHTML").Close
Related
I am working on a UserForm and I am trying to use an IE/Chrome etc logo in the caption property of the UserForm so that the logo is displayed in the window frame followed by some text.
I have done some browsing and have found the following code online but I get an sub/function not defined error on the line involving ExtractIcon.
UserForm Code
Private Sub UserForm_Initialize
Dim strIconPath As String
Dim lngIcon As Long
Dim lnghWnd As Long
' Change to the path and filename of an icon file
strIconPath = "C:\Users\suttond\Desktop\Picture2.gif"
' Get the icon from the source
lngIcon = ExtractIcon(0, strIconPath, 0)
' Get the window handle of the userform
lnghWnd = FindWindow("ThunderDFrame", UserForm1.Caption)
'Set the big (32x32) and small (16x16) icons
SendMessage lnghWnd, WM_SETICON, True, lngIcon
SendMessage lnghWnd, WM_SETICON, False, lngIcon
End Sub
Module Code
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function ExtractIcon _
Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Private Declare Function SendMessage _
Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Integer, _
ByVal lParam As Long) As Long
Private Const WM_SETICON = &H80
Essentially a small IE Explorer logo would display to the left of text already in the caption.
Edit
Module code functions updated to public to allow them to be called from the initialize code. No longer getting the extract error but the image is not appearing in the UserForm caption.
As Mistella and Rory mentioned in the comments of your questions, the functions and the constant needs to be declared as Public. If you declare them as Private, they are only known within the Module, but not in the Form.
Second thing is you need to read the Icon from an ICO-file, not from a gif, so you need to convert it. I use IrfanView for tasks like this, but there are tons of tools (even online) available. I did a quick test and it worked:
I'm using URLDownloadToFileA API call to download files in VBA, which works fine (and is MUCH faster than WinHTTP or XMLHTTP), but it's synchronous only.
I've been searching for ways to use a URLMon API call asynchronously (perhaps using URLOpenStream instead of download-to-file), but haven't figured out a way to do this.
I stumbled upon VB6 code that might be able to do it here: http://www.mvps.org/emorcillo/download/vb6/adl.zip but I am not versed enough in coding to convert this to working VBA.
Please note: I do realize how to do this through XMLHTTP and WinHTTP with a class, but those are significantly slower than using the URLMon DLL API, so am hoping to find a solution there.
Code to do it synchronously with URLMon:
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
Private Declare PtrSafe Function URLOpenPullStreamA Lib "URLMON" (ByVal pcaller As Long, ByVal szurl As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As LongPtr
Sub test()
dim a&, b&, URL$
URL = "http://ipv4.download.thinkbroadband.com/100MB.zip"
a = URLOpenPullStreamA (0, URL, 0, 0)
b = URLDownloadToFileA(0, URL, "c:\testfiles\100MB.zip", 0, 0)
End Sub
So, this works - but I don't know how to capture the callback for a, and while downloading b it locks excel until the file is fully downloaded.
Any help would be greatly appreciated!
One way would be to start the VBA code in a separate Office application, have it exit upon the end of the synchronous download and monitor when it exits from the main application.
I have an Excel workbook that sends information to another application (via VBA), which in turn produces a pop-up window with the results of that information, and which I then need for my Excel workbook. Is there any way to have Excel read the information from that other application's pop-up window and paste it into itself?
[]
Here is a picture of the dialog box. What I need is the date and time from it.
It's from a program that was written in VB6. It produces its own popup window. It looks like a custom dialog box.
I don't have access to the outside application's code. It looks like a proprietary program written in VB6 that has its own function buttons, one of which does the calculations with the inputted data, then creates a dialog box with the calculated data. There are no fields in the dialog box to grab the data, it's simply just a box containing data with an "OK" button. Right now, we copy the values down manually, then move on to the next calculation.
Thanks for your help :)
This worked for me, using a test dialog from a .NET Windows Forms project.
The dialog caption was "Tester!" and it contained a single label with some text.
Your situation will be a little different: you will need to determine the "class" of the control containing the text you need. You can use Spy++ for this.
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) 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
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Sub main()
Dim lngHWnd As Long
Dim lngHWndChild As Long
Dim lngIndex As Long
Dim lngDlgItem As Long
Dim lngTextLength As Long
Dim strText As String
lngHWnd = FindWindow(vbNullString, "Tester!")
lngHWndChild = FindWindowEx(lngHWnd, 0&, "WindowsForms10.STATIC.app.0.3ee13a2_r17_ad1", vbNullString)
lngTextLength = GetWindowTextLength(lngHWndChild)
strText = Space(lngTextLength)
GetWindowText lngHWndChild, strText, lngTextLength + 1
Debug.Print strText
End Sub
Spy++ - press Alt+F3 then drag the "target" onto the dialog to locate it in the tree.
I have an Excel VBA UDF that performs some expensive calculations. Currently, Excel tries to run the function when the user clicks on the Insert Function dialog (the 'fx' button next to the formula bar), and this causes problems in my code.
Is there a way I can set the function to not calculate when the user has the Insert Function dialog (or the Function Arguments dialog, which is what shows up when the function name is already provided) open? I'd like to have the function only run when the user enters the formula in a cell or refreshes the sheet.
try adding this code to the start of your function:
If (Not Application.CommandBars("Standard").Controls(1).Enabled) Then Exit Function
It will quit your UDF if the function wizard is being used
There is one circumstance in which the "CommandBars" solution provided by Charles Williams fails, falsely indicating that the function wizard is active when it's not.
It happens when you open a comma-separated text file in Excel in which case all open Excel workbooks are recalculated, even if Excel calculation is set to manual. That's quite disruptive if you have workbooks open with slow-to-calculate VBA UDFs that use the CommandBars test to exit early if the Wizard is thought to be active.
Charles further suggests that the Windows API can be used as an alternative approach. I've not been able to find such code elsewhere so here's my attempt to implement Charles' suggestion.
Tested only on English-language 64-bit Excel 365.
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As LongPtr, ByRef lpdwProcessId As Long) As Long
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
Private Const GW_HWNDNEXT = 2
Function FunctionWizardActive() As Boolean
Dim ExcelPID As Long
Dim lhWndP As LongPtr
Dim WindowTitle As String
Dim WindowPID As Long
Const FunctionWizardCaption = "Function Arguments" 'This won't work for non English-language Excel
If TypeName(Application.Caller) = "Range" Then
'The "CommandBars test" below is usually sufficient to determine that the Function Wizard is active,
'but can sometimes give a false positive. Example: When a csv file is opened (via File Open) then all
'active workbooks are calculated (even if calculation is set to manual!) with
'Application.CommandBars("Standard").Controls(1).Enabled being False
'So apply a further test using Windows API to loop over all windows checking for a window with title "Function Arguments", checking also the process id.
If Not Application.CommandBars("Standard").Controls(1).Enabled Then
ExcelPID = GetCurrentProcessId()
lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
Do While lhWndP <> 0
WindowTitle = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
GetWindowText lhWndP, WindowTitle, Len(WindowTitle)
WindowTitle = Left$(WindowTitle, Len(WindowTitle) - 1)
If WindowTitle = FunctionWizardCaption Then
GetWindowThreadProcessId lhWndP, WindowPID
If WindowPID = ExcelPID Then
FunctionWizardActive = True
Exit Function
End If
End If
lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
Loop
End If
End If
End Function
With that function available, you can amend your slow VBA UDFs with the code:
If FunctionWizardActive() Then Exit Function
Is there any option to change the excel icon in taskbar for Excel?
Disclaimer: I usually do not answer questions where the OP has shown no efforts but this was way too interesting to pass on. But do not be surprised if this question gets closed :)
Is there any option to change the excel icon in taskbar for Excel
Yes there is. You have to use 3 APIs for this
ExtractIcon32, GetActiveWindow32 and SendMessage32
To read about them see THIS LINK. This is my favorite one stop for APIs :)
Declare Function ExtractIcon32 Lib "shell32.dll" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Declare Function GetActiveWindow32 Lib "user32" _
Alias "GetActiveWindow" () As Integer
Declare Function SendMessage32 Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Sub Sample()
Dim myIcoFile As String
Dim NewIco
'~~> Change this to the relevant icon file
myIcoFile = "D:\Temp\icons\CHARACT\$SIGN1.ico"
NewIco = ExtractIcon32(0, myIcoFile, 0)
SendMessage32 GetActiveWindow32(), &H80, 1, NewIco
End Sub