The fastest way to change desktop folder location programmatically - winapi

I want to create an application that allows users to have different icons on different Windows 10 desktops. I can deal with the switching of virtual desktops using the Window Station and Desktop functions and the Virtual Desktop Shell Interface. So now I know how to detect that a desktop has been switched and I need to change the location of the Desktop User Folder as fast as possible.
I know there are two ways of doing this in the User Interface:
A) Via User Folders' properties
Open %HomePath%/Desktop in Explorer
Right click on background, open Properties
In tab Location type in the new path
Hit OK and then No (as you don't want to move the files)
Sometimes needed: click on desktop, press F2
.
B) Via Registry
Change Desktop in HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders to the new address
Relog
.
The B option would be ideal for a programmatical solution if it wasn't for that relog part. Which is, as you can certainly understand, a bit of a dealbreaker.

The VB.Net code below will save all open desktop folder locations and sizes in the Windows registry and restore them on demand. Run from the command line or a batch file. To save folder attributes add a parameter of 'Set' (no quotes), to restore, no parameter.
Option Explicit On
Imports System.Text
Public Class FixFolders
Structure RECT
Dim Left As Integer
Dim Top As Integer
Dim Right As Integer
Dim Bottom As Integer
End Structure
Structure POINTAPI
Dim x As Integer
Dim y As Integer
End Structure
Structure WINDOWPLACEMENT
Dim length As Integer
Dim flags As Integer
Dim showCmd As Integer
Dim ptMinPosition As POINTAPI
Dim ptMaxPosition As POINTAPI
Dim rcNormalPosition As RECT
End Structure
Private Structure TDeskTopWindow
Dim lhwnd As Integer
Dim WinTitle As String
Dim WinRect As RECT
End Structure
Private Declare Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
Declare Function MoveWindow Lib "user32" (ByVal hwnd As Int32, ByVal x As Int32, ByVal y As Int32, ByVal nWidth As Int32, ByVal nHeight As Int32, ByVal bRepaint As Int32) As Int32
Declare Function GetDesktopWindow Lib "user32" () As Int32
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Int32, ByVal lpClassName As String, ByVal nMaxCount As Int32) As Int32
Private Delegate Function EnumChildWindowsCallback(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As Boolean
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWnd As IntPtr, ByVal lpEnumFunc As EnumChildWindowsCallback, ByVal lParam As IntPtr) As Boolean
Private Delegate Function EnumWindowsProcDelegate(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As Boolean
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumWindowsProcDelegate, ByVal lParam As IntPtr) As Boolean
Private Declare Auto Function GetWindowText Lib "user32" (ByVal hWnd As IntPtr, ByVal lpString As StringBuilder, ByVal nMaxCount As Integer) As Integer
Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As Int32) As Int32
Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Integer, ByRef lpwndpl As WINDOWPLACEMENT) As Integer
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwbd As Int32) As Int32
'Private Declare Function FlashWindow Lib "User32" (ByVal hWnd As Int32, ByVal Invert As Int32) As Int32
Private Declare Function SetActiveWindow Lib "User32" (ByVal hWnd As Int32) As Int32
Private Shared lpwndplNew As WINDOWPLACEMENT
Private Const SW_SHOWMINIMIZED As Short = 2
Private Const SW_SHOWMAXIMIZED As Short = 3
Private Const SW_SHOWNORMAL As Short = 1
Private Shared Mode As String
Private WindowArray() As String
Private Shared DeskTopWindows() As TDeskTopWindow, DTWinIndex As Integer
Public Shared Sub Main()
Dim left, Right, Top, Bottom As Integer
Dim DTWinIndex As Integer
Dim RetVal1, RetVal2, RetVal3, TimeOut As Integer
Mode = Command()
GetDeskTopFolderWindows()
For DTWinIndex = 0 To DeskTopWindows.GetUpperBound(0)
Select Case Mode
Case ""
With DeskTopWindows(DTWinIndex)
'If it' s not there, put it in
If GetSetting("FixFolders", .WinTitle, "Left") = "" Then
SaveSetting("FixFolders", .WinTitle, "Left", .WinRect.Left.ToString)
SaveSetting("FixFolders", .WinTitle, "Right", .WinRect.Right.ToString)
SaveSetting("FixFolders", .WinTitle, "Top", .WinRect.Top.ToString)
SaveSetting("FixFolders", .WinTitle, "Bottom", .WinRect.Bottom.ToString)
End If
left = Val(GetSetting("FixFolders", .WinTitle, "Left"))
Right = Val(GetSetting("FixFolders", .WinTitle, "Right"))
Top = Val(GetSetting("FixFolders", .WinTitle, "Top"))
Bottom = Val(GetSetting("FixFolders", .WinTitle, "Bottom"))
While .WinRect.Bottom <> Bottom Or .WinRect.Left <> left Or .WinRect.Right <> Right Or .WinRect.Top <> Top
'RetVal1 = SetForegroundWindow(lhWnd)
RetVal2 = SetWindowPlacement(.lhwnd, lpwndplNew) 'This 'restores' the window if minimized
RetVal3 = MoveWindow(.lhwnd, left, Top, Right - left, Bottom - Top, True)
' Log.WriteLine(Now.TimeOfDay.ToString.Substring(0, 8) & " Set " & .WinTitle)
RetVal1 = GetWindowRect(.lhwnd, .WinRect) ' get current size
TimeOut += 1
If TimeOut > 1 And TimeOut < 10 Then Threading.Thread.Sleep(1000)
End While
End With
Case "Set"
With DeskTopWindows(DTWinIndex)
SaveSetting("FixFolders", .WinTitle, "Left", .WinRect.Left.ToString)
SaveSetting("FixFolders", .WinTitle, "Right", .WinRect.Right.ToString)
SaveSetting("FixFolders", .WinTitle, "Top", .WinRect.Top.ToString)
SaveSetting("FixFolders", .WinTitle, "Bottom", .WinRect.Bottom.ToString)
End With
End Select
Next
End Sub
Private Shared Sub GetDeskTopFolderWindows()
Dim lhwnd As Integer, lParam As IntPtr
DTWinIndex = -1
lhwnd = GetDesktopWindow() ' Find the Desktop's Child Windows
EnumChildWindows(lhwnd, AddressOf EnumChildProc, lParam)
End Sub
Shared Function EnumChildProc(ByVal lhWnd As IntPtr, ByVal lParam As IntPtr) As Boolean
Dim RetVal1 As Int32
Dim WinClassBuf As String
Dim WinTitleBuf As New StringBuilder(256)
Dim WinClass As String
Dim WinRect As RECT
WinClassBuf = New String(Chr(0), 256)
WinTitleBuf.Append(Chr(0), 256)
RetVal1 = GetClassName(lhWnd, WinClassBuf, WinClassBuf.Length)
WinClass = WinClassBuf.ToString
WinClass = StripNulls(WinClassBuf) ' remove extra Nulls & spaces
If WinClass = "CabinetWClass" Or WinClass = "ExploreWClass" Then ' TextBox Window
DTWinIndex += 1
ReDim Preserve DeskTopWindows(DTWinIndex)
DeskTopWindows(DTWinIndex).lhwnd = lhWnd
GetWindowText(lhWnd, WinTitleBuf, WinTitleBuf.Capacity)
DeskTopWindows(DTWinIndex).WinTitle = WinTitleBuf.ToString
RetVal1 = GetWindowRect(lhWnd, WinRect) ' get current size
DeskTopWindows(DTWinIndex).WinRect = WinRect
End If
EnumChildProc = True
End Function
Public Shared Function StripNulls(ByVal OriginalStr As String) As String
' This removes the extra Nulls so String comparisons will work
If (InStr(OriginalStr, Chr(0)) > 0) Then
'OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
OriginalStr = OriginalStr.Substring(0, OriginalStr.IndexOf(Chr(0)))
End If
StripNulls = OriginalStr
End Function
End Class

Related

How can I get any Browser's URL in VB6?

Recently, I was trying to make a program for saving all visited URLs in a text file from any browser using Visual Basic 6. I have found some codes for VB.NET, but I like programming in VB6.
VB.NET Code for getting browser URL
Option Explicit On
Imports System.Text
Imports System.Runtime.InteropServices.Marshal
Module CurrentUrl
#Region " Overview & References "
'Overview:
'Function GetCurrentUrl returns the URL of the selected browser (IE or Chrome; Firefox to be added).
'Most of the code is based on the references listed below, but this function starts with
'the browser's main window handle and returns only 1 URL.
'It also builds a simple "treeview" of the windows up to the target window's classname.
'References:
'http://www.xtremevbtalk.com/archive/index.php/t-129988.html
'http://social.msdn.microsoft.com/forums/en-us/vbgeneral/thread/321D0EAD-CD50-4517-BC43-29190542DCE0
'http://social.msdn.microsoft.com/Forums/en/vbgeneral/thread/02a67f3a-4a26-4d9a-9c67-0fdff1428a66
#End Region
#Region " Declares, Constants, and Variables"
Private Delegate Function EnumProcDelegate(ByVal hwnd As IntPtr, ByVal lParam As IntPtr) As Boolean 'Delegate added
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumProcDelegate, ByVal lParam As IntPtr) As Boolean
Private Declare Auto Function GetWindowText Lib "user32" (ByVal hWnd As IntPtr, ByVal lpString As StringBuilder, ByVal nMaxCount As Integer) As Integer
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As IntPtr, ByVal wCmd As IntPtr) As IntPtr
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As IntPtr, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDFIRST = 0
Private sURL As String 'String that will contain the URL
Private cbWindows As ComboBox 'Treeview"
Private sIndent As String 'Spaces
Private sBrowser As String 'Starting window (IE or Chrome)
Private sClassName As String = "Edit" 'Default
#End Region
Public Function GetCurrentUrl(ByVal hwnd As IntPtr, ByVal browser As String, ByVal classname As String, ByVal combo As ComboBox) As String
sBrowser = browser
sClassName = classname
cbWindows = combo
If cbWindows IsNot Nothing Then
If cbWindows.GetType.Name = "ComboBox" Then
cbWindows.Items.Clear()
Else
cbWindows = Nothing
End If
End If
sURL = ""
sIndent = ""
EnumWindows(AddressOf EnumProc, hwnd) 'hwnd - originally IntPtr.Zero
Return sURL
End Function
' Enumerate the windows
' Find the URL in the browser window
Private Function EnumProc(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As Boolean
Dim buf As StringBuilder = New StringBuilder(256) 'String * 1024
Dim title As String
Dim length As Integer
' Get the window's title.
length = GetWindowText(hWnd, buf, buf.Capacity)
title = Left(buf.ToString, length)
' See if the title ends with the browser name
Dim s As String = sBrowser
Dim inprivate = sBrowser & " - [InPrivate]" 'IE adds this to the window title
If title <> "" Then
If (Right(title, s.Length) = s) Or (Right(title, inprivate.Length) = inprivate) Then
' This is it. Find the URL information.
sURL = EditInfo(hWnd, cbWindows)
Return False
End If
End If
' Continue searching
Return True
End Function
' If this window is of the Edit class (IE) or Chrome_AutocompleteEditView (Google), return its contents.
' Otherwise search its children for such an object.
Private Function EditInfo(ByVal window_hwnd As IntPtr, ByRef cbWindows As ComboBox) As String
Dim txt As String = ""
Dim buf As String
Dim buflen As Integer
Dim child_hwnd As IntPtr
Dim children() As IntPtr = {}
Dim num_children As Integer
Dim i As Integer
'Get the class name.
buflen = 256
buf = Space(buflen - 1)
buflen = GetClassName(window_hwnd, buf, buflen)
buf = Left(buf, buflen)
'Add an item to the window list combo, indent as required
If cbWindows IsNot Nothing Then
cbWindows.Items.Add(sIndent & buf)
End If
' See if we found an Edit/AutocompleteEditView object.
If buf = sClassName Then
Return WindowText(window_hwnd)
End If
' It's not an Edit/AutocompleteEditView object. Search the children.
' Make a list of the child windows.
num_children = 0
child_hwnd = GetWindow(window_hwnd, GW_CHILD)
While child_hwnd <> 0
num_children = num_children + 1
ReDim Preserve children(0 To num_children) 'was 1 to ..
children(num_children) = child_hwnd
child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT)
End While
' Get information on the child windows.
sIndent &= " "
For i = 1 To num_children
txt = EditInfo(children(i), cbWindows)
If txt <> "" Then Exit For
Next i
sIndent = Left(sIndent, sIndent.Length - 4)
Return txt
End Function
' ************************************************
' Return the text associated with the window.
' ************************************************
Private Function WindowText(ByVal window_hwnd As IntPtr) As String
Dim txtlen As Integer
Dim txt As String
txt = "" 'WindowText = ""
If window_hwnd = 0 Then Return "" 'Exit Function
'Get the size of the window text
txtlen = SendMessage(window_hwnd, WM_GETTEXTLENGTH, 0, 0)
If txtlen = 0 Then Return "" 'Exit Function
'Extra for terminating char
txtlen = txtlen + 1
'Alloc memory for the buffer that recieves the text
Dim buffer As IntPtr = AllocHGlobal(txtlen)
'Send The WM_GETTEXT Message
txtlen = SendMessage(window_hwnd, WM_GETTEXT, txtlen, buffer) 'byval txt
'Copy the characters from the unmanaged memory to a managed string
txt = PtrToStringAnsi(buffer)
Return Left(txt, txtlen)
End Function
End Module

VBS send mouse clicks?

I need send mouse clicks from VBS. Like SendKeys. I have searched whole google, it seems there is no such function for VBS. Can you give me some solution?
Here is a routine to send a left or right click to a window (using relative references) in VBA for Excel. Similar to AppActivate, you just need the window title.
The arguments when you call the SendClick routine are:
Window Title (String)
Buttons (1 = Left, 2 = Right, -1 = Move mouse only; no click)
x (Relative position to window Left)
y (Relative position to window Top)
Enjoy!
'Declare mouse events
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
'Declare sleep
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' Window location
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Function WindowHandle(ByVal sTitle As String) As Long
WindowHandle = FindWindow(vbNullString, sTitle)
End Function
Public Sub SendClick(sWnd As String, b As Integer, x As Long, y As Long)
Dim pWnd As Long, pRec As RECT
pWnd = WindowHandle(sWnd)
GetWindowRect pWnd, pRec
SetCursorPos pRec.Left + x, pRec.Top + y
Sleep 50
If b = 2 Then
mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
Sleep 50
mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
ElseIf b <> -1 Then
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
Sleep 50
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End If
End Sub
It's not possible with VBScript alone. You'll need to use a third-party tool like nircmd. You can use its setcursor, setcursorwin, movecursor, and sendmouse commands to manipulate the mouse.
For example, here's how to move the cursor to a screen coordinate (measured from the top left) and perform a right-click:
With CreateObject("WScript.Shell")
.Run "nircmd setcursor 100 100", 0, True
.Run "nircmd sendmouse right click", 0, True
End With
See the documentation for parameter information.
Try
Dim x
set x=createobject("wscript.shell")
x.sendkeys"{CLICK LEFT,50,60}"
or
x.SendKeys("+{F10}") 'for a right click
If neither of those work for you I would suggest using something like Autoit or autohotkey, using AutoHotKey you could write a macro that does the clicking and then call the script from your VBScript.
VBS is a script, not an application; VBScripts can call other applications or Component Objects to access elements of the host environment, just like batch files; eg. FileSystemObject to manipulate files.
There isn't one provided for mouse, so to move mouse or send mouse clicks, you'd need to call some app or COM object to do it, or make one.
Some apps that can manipulate the mouse are MSWord & MSExcel (via WinAPI calls), NirCmd, AutoIt, AutoHotKey, etc
Here's a VBApp example that calls functions of the User Component: user32.dll:
(Notice how the arguments are formatted before being sent to the DLL. This is not possible in VBS or batch files since they can only pass Strings as args; some functions expect data types eg. Int32, window handles or object references)
Option Strict On
Option Explicit On
Option Infer On
Imports System.Runtime.InteropServices
Public Class Mousing
Private Declare Auto Sub mouse_event Lib "user32" (ByVal dwFlags As Int32, ByVal dx As Int32, ByVal dy As Int32, ByVal cButtons As Int32, ByVal dwExtraInfo As IntPtr)
Private Const MOUSEEVENTF_LEFTDOWN As Int32 = &H2
Private Const MOUSEEVENTF_LEFTUP As Int32 = &H4
Private Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Private Const MOUSEEVENTF_RIGHTUP As Long = &H10
<StructLayout(LayoutKind.Sequential)>
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
<DllImport("user32.dll")> _
Private Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, EntryPoint:="FindWindow")> _
Private Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
End Function
<DllImport("user32.dll", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
Private Shared Function SetForegroundWindow(ByVal hwnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
' find the window
Dim hWnd As IntPtr = FindWindow(Nothing, "Some Window")
' check if window found
If hWnd.Equals(IntPtr.Zero) Then
MessageBox.Show("Window Not Found!", "Aborting", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return ' exit
Else
' bring the window to the foreground
SetForegroundWindow(hWnd)
' get the windows size and location
Dim r As New RECT
GetWindowRect(hWnd, r)
'Move the cursor to the windows location plus our offset (x + 50 , y + 100)
Windows.Forms.Cursor.Position = New System.Drawing.Point(r.Left + 50, r.Top + 100)
' To move relative to screen, just enter coordinates above without offsetting
' click the left mouse button at the current mouse position
mouse_event(MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, IntPtr.Zero)
End If
End Sub
End Class
The following is a VBScript calling AutoIt to move mouse & click:
Set oAutoIt = WScript.CreateObject("AutoItX.Control")
set oShell = CreateObject("WScript.Shell")
oAutoIt.MouseMove x,y,0
WScript.Sleep 500
oAutoIt.MouseClick($MOUSE_CLICK_PRIMARY)
References:
http://www.vbforums.com/showthread.php?672196-RESOLVED-SetCursorPos
http://www.ericphelps.com/batch/rundll/
https://www.dostips.com/forum/viewtopic.php?t=3931
https://support.microsoft.com/en-au/help/152969/visual-basic-procedure-to-get-set-cursor-position
https://microsoft.public.scripting.vbscript.narkive.com/ZO09Cxnz/moving-mouse-pointer-with-vbs-file

GetWindowText does not work

I'm trying to retrieve the text from an EDIT control using GetWindowText and GetWindowTextLength. The application retrieves the text from the window under the cursor and it works on all windows with a caption or text with the exception of the EDIT control. The EDIT control is the result window on the Windows XP Calculator, calc.exe.
Dim S As String
Dim L As Long
L = GetWindowTextLength(handle) + 1
Receiving string = GetWindowText(handle, S, L)
EDIT:
According to SPY++ the Edit class control does not receive the EM_GETSELTEXT or the WM_GETTEXT message.The code below retrieves the text from the Edit class control on the Windows XP calc.exe calculator every time that I press a button on my UI. It is not the method that I would have preferred to use, however, it accomplishes my task.
Const EM_SETSEL = &HB1
Const ES_READONLY = &H800
Const WM_COPY = &H301
Const EM_GETSELTEXT = &H43E
Const WM_GETTEXTLENGTH = &HE
Const WM_SETFOCUS As Long = &H7
Dim L As Long
L = SendMessage(EditHwnd, WM_GETTEXTLENGTH, 0&, 0)
SendMessage EditHwnd, WM_SETFOCUS, 0&, 0
SendMessage EditHwnd, EM_SETSEL, 0&, L
SendMessage EditHwnd, ES_READONLY, 0&, 0 ' read only = false
Clipboard.Clear
SendMessage EditHwnd, WM_COPY, 0&, 0
SendMessage EditHwnd, ES_READONLY, 1&, 0 ' read only = true
Receiving string = Clipboard.GetText
Clipboard.Clear
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Function GetText(handle As Long) As String
Dim S As String, L As Integer, cch As Long
L = GetWindowTextLength(handle) + 1
S = String(L, 0)
GetText = Mid(S, 1, GetWindowText(handle, S, L))
End Function
Private Sub Form_Load()
Dim hw As Long
hw = Me.hwnd
MsgBox GetText(hw)
End Sub
But it will not work with controls like EDIT, as it is written in help. ;( In order to get the text of the child window (control), try to get a list of all windows using API EnumWindows/EnumThreadWindows/GetWindowThreadProcessId, to find the desired control.
What is the name of the class to EDIT You need? What is its width and height? I could write code specifically for the search for this control.
this code works fine in Windows XP (virtual machine)
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As Any, ByVal lpsz2 As Any) As Long
Private Declare 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
Private Declare Function AttachThreadInput Lib "user32.dll" _
(ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Const WM_GETTEXT As Long = &HD&
Private Const WM_GETTEXTLENGTH As Long = &HE&
Function WindowText(ByVal hWnd As Long) As String
Dim ret As Long
ret = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, ByVal 0&)
WindowText = String(ret, 0)
ret = SendMessage(hWnd, WM_GETTEXT, ret + 1, ByVal WindowText)
End Function
Private Sub Command1_Click()
Dim hCalc As Long, hEdit As Long
hCalc = FindWindow("SciCalc", vbNullString)
hEdit = FindWindowEx(hCalc, 0&, "Edit", vbNullString)
MsgBox WindowText(hEdit)
End Sub

How to give file path to "save as" window using vb6

I'm working on a VB6 code.
It has to perform the following operations in sequence:
1. Check the window is open or not (Done! using FindWindows)
2. Press Ctrl + S (Done! using SendKeys("^S")
3. Type full path name (Stuck here! Don't know how to proceed)
4. Hit Enter key (Done! using SendKeys)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName 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
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
'--------------------------------------------------------
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal lhWndP As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal lhWndP As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) 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 SetForegroundWindow Lib "user32" ( _
ByVal hWnd As Long) _
As Long
Private Const BM_CLICK = &HF5
Private Const WM_CLOSE = &H10
Private Const WM_SETTEXT As Long = &HC
'------------------------------------------------------------
Private Const GW_HWNDNEXT = 2
Private Sub Command1_Click()
Dim lhWndP As Long
Dim lhWndP1 As Long
Dim hWnd1 As Long
Dim hWnd11 As Long
If Dir$("C:\users\public\123.txt") <> "" Then
Kill ("C:\users\public\123.txt")
End If
If GetHandleFromPartialCaption(lhWndP, "Untitled - Notepad") = True Then
SetForegroundWindow lhWndP
DoEvents
Call VBA.SendKeys("^s")
DoEvents
Call VBA.SendKeys("C:\users\public\123.txt") 'This is not working 100%
If GetHandleFromPartialCaption(lhWndP1, "Save As") = True Then
DoEvents
hWnd11 = FindWindowEx(lhWndP1, 0, "Button", "&Save")
If hWnd11 <> 0 Then
Call PostMessage(hWnd11, BM_CLICK, 0, 0)
Else
MsgBox "Button handle not found!"
End If
End If
hWnd11 = FindWindowEx(lhWndP1, 0, "Button", "&Save")
If hWnd11 <> 0 Then
Call PostMessage(hWnd1, BM_CLICK, 0, 0)
Else
MsgBox "Button handle not found!"
End If
End If
End
End Sub
Public Function GetHandleFromPartialCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
Dim lhWndP As Long
Dim sStr As String
GetHandleFromPartialCaption = False
lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
Do While lhWndP <> 0
sStr = String$(GetWindowTextLength(lhWndP) + 1, Chr$(0))
GetWindowText lhWndP, sStr, Len(sStr)
sStr = Left$(sStr, Len(sStr) - 1)
If InStr(1, sStr, sCaption) > 0 Then
GetHandleFromPartialCaption = True
lWnd = lhWndP
Exit Do
End If
lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
Loop
End Function
I tried sendmessage function. But WM_SETTEXT is setting some junk to the window title and not in file name field.
Any alternate for this WM_SETTEXT ? or some other method to accompolish the task?
Note: In this example i've used a notepad. But actual application uses a third party window. I dont have code for that application.
The problem is that you aren't waiting for the SendKeys text to be processed by the target application. A call to DoEvents is not the same thing as waiting for an external application to do something. It allows your application to flush the rest of its event queue.
If you need to wait for an external application to process, the quick and dirty way to do it is add a short Sleep. Declare the API function as...
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
...and then try this:
'...
If GetHandleFromPartialCaption(lhWndP, "Untitled - Notepad") = True Then
SetForegroundWindow lhWndP
Sleep 100
Call VBA.SendKeys("^s")
Sleep 100
Call VBA.SendKeys("C:\users\public\123.txt") 'This is not working 100%
If GetHandleFromPartialCaption(lhWndP1, "Save As") = True Then
Sleep 100
hWnd11 = FindWindowEx(lhWndP1, 0, "Button", "&Save")
If hWnd11 <> 0 Then
Call PostMessage(hWnd11, BM_CLICK, 0, 0)
Else
MsgBox "Button handle not found!"
End If
End If
hWnd11 = FindWindowEx(lhWndP1, 0, "Button", "&Save")
If hWnd11 <> 0 Then
Call PostMessage(hWnd1, BM_CLICK, 0, 0)
Else
MsgBox "Button handle not found!"
End If
End If
'...
If that still doesn't work, adjust the Sleep times until it does.

Setting the name of a file in the Windows Save File dialog

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.

Resources