i tried a lot to make this code to work,but with no chance.
i want to run a link example: www.yahoo.com in chrome but in hidden mode using sw_hide for a moment of time and this is my code :
Imports System.IO
Imports Microsoft.Win32
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Imports System.Threading
Module Module1
Const SW_HIDE As Integer = 0
Const SW_RESTORE As Integer = 9
Const SW_MINIMIZE As Integer = 6
Const SW_SHOWMINIMIZED As Integer = 2
Dim hWnd As Integer = 0
<DllImport("User32")> Private Function ShowWindow(ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
End Function
Sub main()
Threading.Thread.Sleep(3000)
Dim ProcessProperties As New ProcessStartInfo
ProcessProperties.FileName = "chrome"
ProcessProperties.Arguments = "www.yahoo.com"
Dim myProcess As Process = Process.Start(ProcessProperties)
Threading.Thread.Sleep(5000)
Call Chm()
Threading.Thread.Sleep(10000)
Call shwo()
Threading.Thread.Sleep(1000)
End Sub
Sub Chm()
Dim p As Process() = Process.GetProcessesByName("chrome")
hWnd = p(0).MainWindowHandle.ToInt32
Threading.Thread.Sleep(2000)
ShowWindow(hWnd, SW_HIDE)
End Sub
Sub shwo()
If Not hWnd.Equals(IntPtr.Zero) Then
' is app window found?
ShowWindow(hWnd, SW_SHOWMINIMIZED)
End If
End Sub
End Module
Related
I set up my own library with functions and subs for VBA (Word) and wanted to create a new class module. But I can't figure out how to use this new class with other files.
StopWatch Example (Normal.dotm, Class module: Global_StopWatch)
Private mlngStart As Long
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Public Sub StartTimer()
mlngStart = GetTickCount
End Sub
Public Function EndTimer() As Long
EndTimer = (GetTickCount - mlngStart)
End Function
StopWatch call (Document.dotm, module: Test)
Sub swTest()
Dim gSW As Global_StopWatch
Set gSW = New Global_StopWatch
gSW.StartTimer
Debug.Print "That took " & gSW.EndTimer & " ms."
End Sub
Can someone help with this?
Normal.dotm - clsStopWatch (Instancing = PublicNotCreatable)
Option Explicit
Private mlngStart As Long
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Public Sub StartTimer()
mlngStart = GetTickCount
End Sub
Public Function EndTimer() As Long
EndTimer = (GetTickCount - mlngStart)
End Function
Normal.dotm - Module1
Public Function StopWatch() As clsStopWatch
Set StopWatch = New clsStopWatch
End Function
Document1 - Module1
Sub Tester()
Dim sw As normal.clsStopWatch, i As Long
Set sw = normal.stopwatch
sw.StartTimer
For i = 1 To 10000000#
'
Next i
Debug.Print sw.endtimer
End Sub
I created a userform in an *.xlam add-in and created a new commandbar and button in the IDE, but when I click the button, the user form is opened in Excel, and focus is forced away from the IDE. Is there a way to open the user form in the IDE instead of the host application without resorting to a .Net COM Add-in?
Here is the code that creates the commandbar and button and handles the button click event.
Option Explicit
Public WithEvents cmdBarEvents As VBIDE.CommandBarEvents
Private Sub Class_Initialize()
CreateCommandBar
End Sub
Private Sub Class_Terminate()
Application.VBE.CommandBars("VBIDE").Delete
End Sub
Private Sub CreateCommandBar()
Dim bar As CommandBar
Set bar = Application.VBE.CommandBars.Add("VBIDE", MsoBarPosition.msoBarFloating, False, True)
bar.Visible = True
Dim btn As CommandBarButton
Set btn = bar.Controls.Add(msoControlButton, , , , True)
btn.Caption = "Show Form"
btn.OnAction = "ShowForm"
btn.FaceId = 59
Set cmdBarEvents = Application.VBE.Events.CommandBarEvents(btn)
End Sub
Private Sub cmdBarEvents_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
CallByName Me, CommandBarControl.OnAction, VbMethod
End Sub
Public Sub ShowForm()
Dim frm As New UserForm1
frm.Show
End Sub
P.S. You may need this line of code to remove the commandbar...
Application.VBE.CommandBars("VBIDE").Delete
Here is an alternative.
Put a button on your user form. For demonstration purpose, I am using this
Next put this code in the userform
Private Sub CommandButton1_Click()
Unload Me
Application.Visible = True
End Sub
Next paste this on top of your class module
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim Ret As Long, ChildRet As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Finally change your Sub ShowForm() to this
Public Sub ShowForm()
Dim frm As New UserForm1
Dim Ret As Long
frm.Show vbModeless
Application.Visible = False
Ret = FindWindow("ThunderDFrame", frm.Caption)
SetWindowPos Ret, HWND_TOPMOST, 100, 100, 250, 200, _
SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Sub
This is what you get
EDIT
More thoughts. To prevent the user from creating more userforms when the user clicks on smiley, change the Sub ShowForm() to the below. (Alternative would be to disable the smiley and re enable it when the form unload?)
Public Sub ShowForm()
Dim frm As New UserForm1
Dim Ret As Long
Dim formCaption As String
'~~> Set Userform Caption
formCaption = "Blah Blah"
On Error Resume Next
Ret = FindWindow("ThunderDFrame", formCaption)
On Error GoTo 0
'~~> If already there in an instance then exit sub
If Ret <> 0 Then Exit Sub
frm.Show vbModeless
frm.Caption = formCaption
Application.Visible = False
Ret = FindWindow("ThunderDFrame", frm.Caption)
SetWindowPos Ret, HWND_TOPMOST, 100, 100, 250, 200, _
SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Sub
I am trying to get the status of my application when is maximized or minimized. I rewrote the script so that its specific for Excel application. However, I am getting an error on this line:
Private Sub GetWindowStats(Process.GetProcessesByName("Excel")(0).MainWindowHandle)
It says that it needs a comma or ")" is expected. I can't see why it would need one and even if I put one, still get a compile error. Here is my entire code:
'Handle the minimize and maximize events on Excel.
Private Const SW_SHOWMAXIMIZED As Integer = 3
Private Const SW_SHOWMINIMIZED As Integer = 2
Private Const SW_SHOWNORMAL As Integer = 1
Private Structure POINTAPI
Public x As Integer
Public y As Integer
End Structure
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
Private Structure WINDOWPLACEMENT
Public Length As Integer
Public flags As Integer
Public showCmd As Integer
Public ptMinPosition As POINTAPI
Public ptMaxPosition As POINTAPI
Public rcNormalPosition As RECT
End Structure
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As IntPtr, ByRef lpwndpl As WINDOWPLACEMENT) As Integer
Private Declare Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As IntPtr
Private Sub GetWindowStats(Process.GetProcessesByName("Excel")(0).MainWindowHandle)
Dim wp As WINDOWPLACEMENT
wp.Length = System.Runtime.InteropServices.Marshal.SizeOf(wp)
GetWindowPlacement(Handle, wp)
If wp.showCmd = SW_SHOWMAXIMIZED Then ' is window maximized?
If Handle = GetForegroundWindow Then ' is the window foreground?
MessageBox.Show("Maximized and forground")
Else
MessageBox.Show("Maximized")
End If
ElseIf wp.showCmd = SW_SHOWNORMAL Then
If Handle = GetForegroundWindow Then
MessageBox.Show("Normal size and forground")
Else
MessageBox.Show("Normal")
End If
ElseIf wp.showCmd = SW_SHOWMINIMIZED Then
MessageBox.Show("Window is Minimized")
End If
End Sub
That is because it need the type for the parameter for this sub routine not the value.
Private Sub GetWindowStats(Handle As IntPtr)
Dim wp As WINDOWPLACEMENT
wp.Length = System.Runtime.InteropServices.Marshal.SizeOf(wp)
GetWindowPlacement(Handle, wp)
If wp.showCmd = SW_SHOWMAXIMIZED Then ' is window maximized?
If Handle = GetForegroundWindow Then ' is the window foreground?
MessageBox.Show("Maximized and forground")
Else
MessageBox.Show("Maximized")
End If
ElseIf wp.showCmd = SW_SHOWNORMAL Then
If Handle = GetForegroundWindow Then
MessageBox.Show("Normal size and forground")
Else
MessageBox.Show("Normal")
End If
ElseIf wp.showCmd = SW_SHOWMINIMIZED Then
MessageBox.Show("Window is Minimized")
End If
End Sub
To Call it:
GetWindowStats(Process.GetProcessesByName("Excel")(0).MainWindowHandle)
Remember if there are no Excel processes this will throw an error.
Hello I have this code working to get current url on Chrome, but only get active tab url. I need to get url from all open tabs using UI Automation.
My working code:
Function GetChromeUrl(ByVal proc As Process) As String
If proc.MainWindowHandle = IntPtr.Zero Then
Return Nothing
End If
Dim element As System.Windows.Automation.AutomationElement = AutomationElement.FromHandle(proc.MainWindowHandle)
If element Is Nothing Then
Return Nothing
End If
Dim edit As System.Windows.Automation.AutomationElement = element.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Edit))
Return (edit.GetCurrentPattern(ValuePattern.Pattern)).Current.Value.ToString
End Function
and call it using this code in Form Load event:
For Each proc As Process In Process.GetProcessesByName("chrome")
MsgBox(proc.MainWindowTitle + " " + GetChromeUrl(proc))
Next
you better try this way
Imports NDde.Client 'import the NDde library for firefox
Imports System.Runtime.InteropServices
'For Chrome
Private Const WM_GETTEXTLENGTH As Integer = &He
Private Const WM_GETTEXT As Integer = &Hd
<DllImport("user32.dll")> _
Private Shared Function SendMessage(hWnd As IntPtr, Msg As UInteger, wParam As Integer, lParam As Integer) As Integer
End Function
<DllImport("user32.dll")> _
Private Shared Function SendMessage(hWnd As IntPtr, Msg As UInteger, wParam As Integer, lParam As StringBuilder) As Integer
End Function
<DllImport("user32.dll", SetLastError := True)> _
Private Shared Function FindWindowEx(parentHandle As IntPtr, childAfter As IntPtr, className As String, windowTitle As String) As IntPtr
End Function
Public Shared Function getChromeUrl(winHandle As IntPtr) As String
Dim browserUrl As String = Nothing
Dim urlHandle As IntPtr = FindWindowEx(winHandle, IntPtr.Zero, "Chrome_AutocompleteEditView", Nothing)
Const nChars As Integer = 256
Dim Buff As New StringBuilder(nChars)
Dim length As Integer = SendMessage(urlHandle, WM_GETTEXTLENGTH, 0, 0)
If length > 0 Then
SendMessage(urlHandle, WM_GETTEXT, nChars, Buff)
browserUrl = Buff.ToString()
Return browserUrl
Else
Return browserUrl
End If
End Function
Public shared Function GetChromeHandle() As Intptr
Dim ChromeHandle As IntPtr = Nothing
Dim Allpro() As Process = Process.GetProcesses();
For Each pro As Process in Allpro
if pro.ProcessName = "chrome"
ChromeHandle = pro.MainWindowHandle
Exit For
End if
Next
Return ChromeHandle
End Function
'USAGE FOR CHROME
Dim CHandle As IntPtr = GetChromeHandle()
If Not CHandle,Equals(Intptr.Zero)
Dim url As String = getChromeUrl(CHandle)
End If
Source and read more
EDIT :
i found my own way and it worked for me
Dim appAs String = "chrome"
Dim proc As System.Diagnostics.Process = GetBrowser(app)
...
Private Function GetBrowser(ByVal appName) As System.Diagnostics.Process
Dim pList() As System.Diagnostics.Process =
System.Diagnostics.Process.GetProcessesByName(app)
For Each proc As System.Diagnostics.Process In pList
If proc.ProcessName = appThen
Return proc
End If
Next
Return Nothing
End Function
usage :
If proc IsNot Nothing Then
Dim browserName as string = "Google Chrome"
Dim className as String = "Edit"
Dim s As String =
GetCurrentUrl(proc.MainWindowHandle, browserName, className, ComboBox1)
If s <> "" Then
Msgbox.show(s)
ComboBox1.SelectedIndex = 0 'Window list
Else
End If
Else
Label1.Text = browserName & " is not available"
end If
hope it helps :))))
i want to start calc.exe and hide it
but only can start the exex but cant hide
what error in my code??
Imports System.Runtime.InteropServices
Imports System.IntPtr
Public Class Form1
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function ShowWindowAsync(ByVal hwnd As IntPtr, ByVal nCmdShow As Integer) As Boolean
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim a As IntPtr = Process.GetProcessesByName("Calc")(0).Id
ShowWindowAsync(a, 0)
End Sub
End Class
The following code should do what you want using managed code, but when I tried it using calc it would not start hidden or minimized (other exe's worked as expected so it may be something peculiar with calc?)
Dim procStartInfo As New ProcessStartInfo
Dim procExecuting As New Process
With procStartInfo
.FileName = "calc"
.WindowStyle = ProcessWindowStyle.Hidden
End With
procExecuting = Process.Start(procStartInfo)
I did time ago a snippet which works with any proccess, are two generic functions and also has recursive mode and is easy to use:
#Region " Hide-Restore Process "
' [ Hide-Restore Process Function ]
'
' // By Elektro H#cker
'
' Examples :
'
' Hide_Process(Process.GetCurrentProcess().MainModule.ModuleName, False)
' Hide_Process("notepad.exe", False)
' Hide_Process("notepad", True)
'
' Restore_Process(Process.GetCurrentProcess().MainModule.ModuleName, False)
' Restore_Process("notepad.exe", False)
' Restore_Process("notepad", True)
Dim Process_Handle_Dictionary As New Dictionary(Of String, IntPtr)
<System.Runtime.InteropServices.DllImport("User32")> Private Shared Function ShowWindow(ByVal hwnd As IntPtr, ByVal nCmdShow As Int32) As Int32
End Function
Private Sub Hide_Process(ByVal Process_Name As String, Optional ByVal Recursive As Boolean = False)
If Process_Name.ToLower.EndsWith(".exe") Then Process_Name = Process_Name.Substring(0, Process_Name.Length - 4)
Dim proc() As Process = Process.GetProcessesByName(Process_Name)
If Recursive Then
For proc_num As Integer = 0 To proc.Length - 1
Try
Process_Handle_Dictionary.Add(Process_Name & ";" & proc(proc_num).Handle.ToString, proc(proc_num).MainWindowHandle)
ShowWindow(proc(proc_num).MainWindowHandle, 0)
Catch ex As Exception
' MsgBox(ex.Message) ' The handle already exist in the Dictionary
End Try
Application.DoEvents()
Next
Else
If Not proc.Length = 0 AndAlso Not proc(0).MainWindowHandle = 0 Then
Process_Handle_Dictionary.Add(Process_Name & ";" & proc(0).Handle.ToString, proc(0).MainWindowHandle)
ShowWindow(proc(0).MainWindowHandle, 0)
End If
End If
End Sub
Private Sub Restore_Process(ByVal Process_Name As String, Optional ByVal Recursive As Boolean = False)
If Process_Name.ToLower.EndsWith(".exe") Then Process_Name = Process_Name.Substring(0, Process_Name.Length - 4)
Dim Temp_Dictionary As New Dictionary(Of String, IntPtr) ' Replic of the "Process_Handle_Dictionary" dictionary
For Each Process In Process_Handle_Dictionary : Temp_Dictionary.Add(Process.Key, Process.Value) : Next
If Recursive Then
For Each Process In Temp_Dictionary
If Process.Key.ToLower.Contains(Process_Name.ToLower) Then
ShowWindow(Process.Value, 9)
Process_Handle_Dictionary.Remove(Process.Key)
End If
Application.DoEvents()
Next
Else
For Each Process In Temp_Dictionary
If Process.Key.ToLower.Contains(Process_Name.ToLower) Then
ShowWindow(Process.Value, 9)
Process_Handle_Dictionary.Remove(Process.Key)
Exit For
End If
Application.DoEvents()
Next
End If
End Sub
#End Region