I have tried to use GetWindowTextW to extract the window title text successfully, and it is a unicode text. When I use FindWindowW to find the window, it failed and the returned Hwnd is 0.
The window with the unicode title:
The code on VB6 is below. the currentHwnd is the window Hwnd I captured already and it works well during my test:
Private Declare Function FindWindowW Lib "user32" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLengthW Lib "user32" (ByVal hWnd As Long) As Long
Private Sub cmdOK_Click()
Dim titleString As String
dim newHwnd as Long
dim Class as string
Class = Space(500)
GetClassName currentHwnd, Class, Len(Class)
titleString = String$(256, 0)
GetWindowTextW currentHwnd, StrPtr(titleString), GetWindowTextLengthW(currentHwnd)
newHwnd = FindWindowW(StrPtr(Class), StrPtr(titleString))
End Sub
Related
I need help on this, I don't know much about windows API, and I'm trying to figure out how I can save a file, and overwrite it (already exists with the same name).
What I'm doing is: Find the application first, send some keys like alt, some down keys, enter.(File->Save as->Enter)
When I press enter, it comes a new window asking confirmation about saving the file.
And then excel freezes, without finding "Confirm Save As Window" and pressing "Yes".
It happens in command:
Call SendMessage(SaveButton, BM_CLICK, 0&, ByVal 0&)
Can anyone help me solving this. Is it happening because it focus is still in save as window or something?
Should I use other way to do what I want?
Public Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Public Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare PtrSafe Function SendMessageByString Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Public Declare PtrSafe Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdSHow As Long) As Long
Public Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal lngHWnd As Long) As Long
Public Declare PtrSafe Function EnableWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Public Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
Public Declare PtrSafe Function GetFocus Lib "user32.dll" () As Long
Public Declare PtrSafe Function SendDlgItemMessage Lib "user32.dll" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const WM_CLOSE As Long = &H10
Public Const SW_SHOW As Integer = 5
Public Const WM_SETTEXT As Long = &HC
Public Const BM_CLICK As Long = &HF5&
Sub PulseAutomation()
CCPUlse = FindWindow(vbNullString, "HxD - [C:\Users\Matthew\Desktop\changelog.txt]")
view13844BringWindowToTop = BringWindowToTop(CCPUlse)
DoEvents
SendKeys "%", True
SendKeys "{DOWN}", True
SendKeys "{DOWN}", True
SendKeys "{DOWN}", True
SendKeys "{DOWN}", True
SendKeys "{DOWN}", True
SendKeys "~", True
Application.Wait (Now + #12:00:01 AM#)
SaveAsWindow = FindWindow(vbNullString, "Save As")
SaveButton = FindWindowEx(SaveAsWindow, 0&, "Button", "&Save")
Call EnableWindow(SaveButton, True)
Call SendMessage(SaveButton, BM_CLICK, 0&, ByVal 0&)
DoEvents
Application.Wait (Now + #12:00:01 AM#)
Dim hWndFind As Long
hWnd = FindWindow(vbNullString, "Confirm Save As")
'get the first child window with the class "Edit" (a textbox to VB)
hWndFind1 = FindWindowEx(hWnd, 0, "DirectUIHWND", vbNullString)
hWndFind2 = FindWindowEx(hWndFind1, 0, "CtrlNotifySink", vbNullString)
hWndFind3 = GetNextWindow(hWndFind2, GW_HWNDNEXT)
hWndFind4 = GetNextWindow(hWndFind3, GW_HWNDNEXT)
hWndFind5 = GetNextWindow(hWndFind4, GW_HWNDNEXT)
hWndFind6 = GetNextWindow(hWndFind5, GW_HWNDNEXT)
hWndFind7 = GetNextWindow(hWndFind6, GW_HWNDNEXT)
hWndFind8 = GetNextWindow(hWndFind7, GW_HWNDNEXT)
hWndFind9 = FindWindowEx(hWndFind8, 0, "Button", vbNullString)
Call SendMessage(hWndFind9, BM_CLICK, 0&, ByVal 0&)
End Sub
Thanks for your advice and your time!
Why are you saving your file like this and not through the VBA method:
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
Wouter
Solution : I used PostMessage instead of SendMessage, for Save button control.
Thanks anyway!
Below is a an updated example where through Excel (vba), the sub opens Notepad, adds text and then prompts for a save as file name. It works except the passing of the file name from the vba code to Windows Save File dialog.
Option Explicit
Private Declare Function AllowSetForegroundWindow Lib "user32.dll" (ByVal dwProcessId As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal lngHWnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpszClass As String, ByVal lpszTitle As String) As Long
Private Declare Function LockSetForegroundWindow Lib "user32.dll" (ByVal uLockCode As Long) As Long
Private Declare Function SendMessageString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const WM_SETTEXT As Long = &HC
Private Const LSFW_LOCK = 1
Private Const VK_CONTROL = &H11 '0x11
Private Const VK_S = &H53 '0x53
Sub WriteToNotepad()
Dim hwndNotepad&, hwndTextbox&, hwndSaveAs&, hwndSaveLocation, hwndFileName&, Retval
ResumeHere:
' Start "Notepad"
Retval = Shell("C:\Windows\System32\NotePad.exe", 4)
' Identify handle for "Notepad" window
hwndNotepad = FindWindowEx(0, 0, "Notepad", vbNullString)
hwndTextbox = FindWindowEx(hwndSaveAs, 0, "Edit", vbNullString)
' Write message
SendMessageString hwndTextbox, WM_SETTEXT, 0, "My message goes here"
' Lock the window for futher input
BringWindowToTop (hwndNotepad)
AllowSetForegroundWindow (hwndNotepad)
SetForegroundWindow (hwndNotepad)
LockSetForegroundWindow (LSFW_LOCK)
' Show Save As dialog box
'Press Ctrl key down, but don't release
keybd_event VK_CONTROL, 0, 0, 0
'Press the letter "S" then release
keybd_event VK_S, 0, 0, 0
keybd_event VK_S, 0, 2, 0
'Release the Alt key
keybd_event VK_CONTROL, 0, 2, 0
' Find SaveAs window before continuing
hwndSaveAs = FindWindowEx(0, 0, "#32770", vbNullString)
hwndFileName = FindWindowEx(hwndSaveAs, 0, "Edit", vbNullString)
' Write file name
SendMessageString hwndFileName, WM_SETTEXT, 0, "Testing file.txt"
End Sub
Well, you certainly don't do it by synthesizing keystrokes. The correct way of pre-filling the file name field in the Save (or Open) dialog is to put the desired string in the lpstrFile member of the OPENFILENAME structure that you pass to the GetSaveFileName function.
When the dialog is closed by the user, that field will be updated with the file name and path that was selected.
In VBA, how can I read the color value of each pixel of in an image?
I found this solution in VB 6.0 but it doesn't apply directly in VBA.
Try the solution posted on this site here :
http://sim0n.wordpress.com/2009/03/27/vba-q-how-to-get-pixel-colour/
I had to change a ByRef to a ByVal but apart from that it works well. Insert a picture using Insert > Picture and assign a macro to the on click event . I've just made it set the colour of cell A1 to the colour you click on, but I'm sure you get the idea.
#If VBA7 Then
Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As LongPtr
Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
#Else
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
#End If
Private Type POINT
x As Long
y As Long
End Type
Sub Picture1_Click()
Dim pLocation As POINT
Dim lColour As Long
Dim lDC As Variant
lDC = GetWindowDC(0)
Call GetCursorPos(pLocation)
lColour = GetPixel(lDC, pLocation.x, pLocation.y)
Range("a1").Interior.Color = lColour
End Sub
To use it, place a picture in a worksheet, right click on the image and assign this macro to it.
I am loading OCX dynamically in VB 6.0.
The following is the code that I am using to load and call the methods:
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long
Private Sub Foo
On Error Resume Next
Dim lb As Long, pa As Long
Dim versionString As String
Dim retValue as Long
lb = LoadLibrary("D:\projects\other\VB_DLLs\TestDLL\TestDLL.dll")
'retrieve the address of getVersion'
pa = GetProcAddress(lb, "getVersion")
'Call the getVersion function'
retValue = CallWindowProc (pa, Me.hWnd, "I want my version", ByVal 0&, ByVal 0&)
'release the library'
FreeLibrary lb
End Sub
Now I want to access public properties of OCX. How I can access (get/set) the properties of OCX?
You can not use an OCX/COM control in that manner.
To create and use an instance of the object, you will need to.. create an instance of the object, then use that.
Set TestObject = CreateObject("TestDll.TestObject")
Value = TestObject.Method(InputValue)
This requires the DLL to be registered, and will use whichever is registered rather than a specific instance.
If you don't want it to be registered, look at DirectCOM.
I want to download multiple files (mostly images) from VB6 application. presently i m using URLDownloadToFile but it allows only one file at a time and there is no progress bar. I want to download multiple files and with progress bar. please help. thanks in advance.
my present code:
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
You want to download the file asynchronously, so that your VB code continues executing while the download happens. There is a little-known way to do this with native VB6, using the AsyncRead method of UserControl and UserDocument objects - no need for API calls.
Here's an excellent explanation and VB6 code for multiple simultaneous downloads, from the renowned VB6 guru Karl Peterson. The AsyncReadProgress event gives you the BytesRead and BytesMax, which will allow you to display a progress bar.
You're hoping for a VB answer, but this is non trivial.
Most of the following comes from http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_20571958.html
IBindStatusCallback interface is not
directly accessible from VB. It must
be introduced into a compatible type
library.
You can find the Type library
olelib.tlb under:
http://www.domaindlx.com/e_morcillo/scripts/type/default.asp
The zip file name to download is:
tl_ole.zip
You will also find examples on how to
use it included. Not sure thou whether
you will find a specific example on
IBindStatusCallback on not, but it
worth giving it a try.
You can write your own function to get the data into a string, which will give you full control over everything:
Option Explicit
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_SERVICE_HTTP = 3
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Long
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Integer
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternet&, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength&, ByVal dwFlags&, ByVal dwContext&) As Long
Public Declare Function InternetQueryDataAvailable Lib "wininet.dll" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Public Function GetHTML(strURL As String) As String
Const BufferSize = 16384
Dim hSession&, hURL&, lRet&, lBytesAvail&
Dim Buffer As String * BufferSize
Dim BufferLen&, sResult$
hSession = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
hURL = InternetOpenUrl(hSession, strURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
sResult = ""
Do
InternetReadFile hURL, Buffer, Len(Buffer), BufferLen
If BufferLen > 0 Then sResult = sResult & Left(Buffer, BufferLen)
Loop Until BufferLen = 0
GetHTML = sResult
InternetCloseHandle hURL
InternetCloseHandle hSession
End Function
You will find additional resources for doing the callback method here (scroll down to the bottom):
http://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/Q_21763861.html
http://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/Q_21746456.html
But I honestly think you'll be better off making your own download function if you want more control over it. TCP/IP stuff in VB is actually very easy.
-Adam