I am using the ROT to find any active MSWord instances. In some versions of word the document does not get registered in the table, instead it is registered as the NORMAL template and so I can not find the document by it's title as documented by microsoft. Anyone know of a hotfix for this?
Is FindWindowPartial API any use to you? It will allow you to search for windows with Microsoft Word in the title.
Option Explicit
Private Const GW_HWNDNEXT = 2
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
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
Function FindWindowPartial(ByVal Title As String) As String
Dim hWndThis As Long
hWndThis = FindWindow(vbNullString, vbNullString)
While hWndThis
Dim sTitle As String, sClass As String
sTitle = Space$(255)
sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))
If InStr(sTitle, Title) > 0 Then
FindWindowPartial = sTitle & "|" & FindWindowPartial
End If
hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
Wend
End Function
Related
I want to locate an recently opened pdf file and save it in a target folder, right now i can able to locate the pdf file using its name and close it but i want to use Save As function.
Code tried to Locate and close the PDF
Option Explicit
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 Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetWindowThreadProcessId _
Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetParent Lib "user32" (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
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Const GW_HWNDNEXT = 2
Const WM_CLOSE = &H10
Const SYNCHRONIZE = &H100000
Public Sub Test()
Dim hWindow As Long
Dim hProcess As Long
Dim lProcessId As Long
Dim lngReturnValue As Long
hWindow = SearchHndByWndName_Parent("vieworder.pdf.php")
hProcess = OpenProcess(SYNCHRONIZE, 0&, lProcessId)
lngReturnValue = PostMessage(hWindow, WM_CLOSE, 0&, 0&)
End Sub
Private Function SearchHndByWndName_Parent(strSearch As String) As Long
Dim strTMP As String * 100
Dim nhWnd As Long
nhWnd = FindWindow(vbNullString, vbNullString)
Do While Not nhWnd = 0
If GetParent(nhWnd) = 0 Then
GetWindowText nhWnd, strTMP, 100
If InStr(strTMP, strSearch) > 0 Then
SearchHndByWndName_Parent = nhWnd
Exit Do
End If
End If
nhWnd = GetWindow(nhWnd, GW_HWNDNEXT)
Loop
End Function
I am working in a restricted environment so I cant add any Adobe dll as reference, also the file which i am looking for is not yet saved in any folder.
Please share your suggestions.
Thank You
I am trying to find out if excel is running, because after i am done creating excel files I need to know if I should close down excel or not.
My method is working fine for me, but it fails on another user and I have no idea why it is failing. My bet would be that the while loop runs forever. So should I add a counter to avoid this or is there a better way to find out if excel is running?
Function ListWins(Optional title = "*", Optional Class = "*") As Boolean
Dim hWndThis As Long
ListWins = True
hWndThis = FindWindow(vbNullString, vbNullString)
While hWndThis
Dim sTitle As String, sClass As String
sTitle = Space$(255)
sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))
sClass = Space$(255)
sClass = Left$(sClass, GetClassName(hWndThis, sClass, Len(sClass)))
If sTitle Like title And sClass Like Class Then
ListWins = False
Debug.Print sTitle, sClass
End If
hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
Wend
End Function
So here is the new function that works for me:
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
Function ExcelOpen() As Boolean
ExcelOpen = FindWindow("XLMAIN", vbNullString)
End Function
I am currently trying to find a way to check whether a window is open or not using Findwindow Function. I am able to find the window if i know the entire name of the window. In the below code i know that the name of the window is "win32api - Notepad" so i can easily find the window however i want to know whether it is possible to identify the window if i know only part name like "win32*".
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub runapplication()
hwnd = FindWindow(vbNullString, "win32api - Notepad")
MsgBox (hwnd)
End Sub
One way you can do this is with the EnumWindows API function. Since it operates via a callback function, you'll need to cache both the criteria and the results somewhere that has scope beyond the calling function:
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, _
ByVal param As Long) As Long
Public Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Public Const MAX_LEN = 260
Public results As Dictionary
Public criteria As String
Public Sub Example()
criteria = "win32*"
Set results = New Dictionary
Call EnumWindows(AddressOf EnumWindowCallback, &H0)
Dim result As Variant
For Each result In results.Keys
Debug.Print result & " - " & results(result)
Next result
End Sub
Public Function EnumWindowCallback(ByVal hwnd As Long, ByVal param As Long) As Long
Dim retValue As Long
Dim buffer As String
If IsWindowVisible(hwnd) Then
buffer = Space$(MAX_LEN)
retValue = GetWindowText(hwnd, buffer, Len(buffer))
If retValue Then
If buffer Like criteria Then
results.Add hwnd, Left$(buffer, retValue)
End If
End If
End If
EnumWindowCallback = 1
End Function
The below code worked for me. Just Declared IsWindowVisible Function and Added Microsoft scripting runtime library to my project.
Public Declare Function EnumWindows Lib "User32" (ByVal lpEnumFunc As Long, _
ByVal param As Long) As Long
Public Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Public Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Long
Public Const MAX_LEN = 260
Public results As Dictionary
Public criteria As String
Public Sub Example()
criteria = "win32"
Set results = New Dictionary
Call EnumWindows(AddressOf EnumWindowCallback, &H0)
Dim result As Variant
For Each result In results.Keys
Debug.Print result & " - " & results(result)
Next result
End Sub
Public Function EnumWindowCallback(ByVal hWnd As Long, ByVal param As Long) As Long
Dim retValue As Long
Dim buffer As String
If IsWindowVisible(hWnd) Then
buffer = Space$(MAX_LEN)
retValue = GetWindowText(hWnd, buffer, Len(buffer))
If retValue Then
If InStr(1, buffer, criteria, vbTextCompare) > 0 Then
results.Add hWnd, Left$(buffer, retValue)
End If
End If
End If
EnumWindowCallback = 1
End Function
Can somebody explain how it can be that the same API call returns so much quicker with VB6 than with VB.NET?
Here is my VB6 code:
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Function GetWindowTextEx(ByVal uHwnd As Long) As String
Dim lLen&
lLen = GetWindowTextLength(uHwnd) + 1
Dim sTemp$
sTemp = Space(lLen)
lLen = GetWindowText(uHwnd, sTemp, lLen)
Dim sRes$
sRes = Left(sTemp, lLen)
GetWindowTextEx = sRes
End Function
And here is my VB.NET code:
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpWindowText As String, ByVal cch As Integer) As Integer
Dim sText As String = Space(Int16.MaxValue)
GetWindowText(hwnd, sText, Int16.MaxValue)
I ran each version 1000 times.
The VB6 version needed 2.04893359351538 ms.
The VB.NET version needed 372.1322491699365 ms.
Both Release and Debug version are about the same.
What is happening here?
Do not use the *A version, just skip the suffix, and use StringBuilder instead of String:
Private Declare Auto Function GetWindowText Lib "user32" (ByVal hwnd As Integer, ByVal lpWindowText As StringBuilder, ByVal cch As Integer) As Integer
Private Declare Function GetWindowTextLength Lib "user32" (ByVal hwnd As Integer) As Integer
Dim len As Integer = GetWindowTextLength (hwnd)
Dim str As StringBuilder = new StringBuilder (len)
GetWindowText (hwnd, str, str.Capacity)
I want to detect currently opened swf file name. Here is my code:
Private Const GW_HWNDNEXT = 2
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount 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
Private Sub Form_Load()
ListWins "*.swf*"
End Sub
Sub ListWins(Optional Title = "*", Optional Class = "*")
Dim hWndThis As Long
hWndThis = FindWindow(vbNullString, vbNullString)
While hWndThis
Dim sTitle As String, sClass As String
sTitle = Space$(255)
sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))
sClass = Space$(255)
sClass = Left$(sClass, GetClassName(hWndThis, sClass, Len(sClass)))
If sTitle Like Title And sClass Like Class Then
Debug.Print sTitle, sClass
List1.AddItem (sTitle)
End If
hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
Wend
End Sub
This code is working fine to detect *.doc, *.xls files name, but not working on *.swf files.
NOTE
I have tested it in VBA. I am sure it will work in VB6 as well.
Try this (Paste this code in a module and run the Sub Sample)
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
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Function APIWindowCaption(ByVal HWnd As Long, ByVal lParam As Long) As Long
Static winnum As Integer
Dim MyStr As String
winnum = winnum + 1
MyStr = String(GetWindowTextLength(HWnd) + 1, Chr$(0))
GetWindowText HWnd, MyStr, Len(MyStr)
'~~> This will give you the caption of the window
If InStr(1, MyStr, ".swf", vbTextCompare) Then Debug.Print MyStr
APIWindowCaption = 1
End Function
Sub Sample()
Dim retval As Long, DesktophWnd As Long
DesktophWnd = GetDesktopWindow
retval = EnumChildWindows(DesktophWnd, AddressOf APIWindowCaption, ByVal 0&)
End Sub
SNAPSHOT