Программно найти окно скайпа

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
 
Private Sub Form_Load()
If FindWindow("tSkMainForm", vbNullString) > 0 Then
MsgBox "Skype найден"
Else
MsgBox "Skype НЕ найден"
End If
 
End Sub

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 Sub Form_Load()
Dim hwnd As Long
Dim MyStr As String
    'Создаем буфер
MyStr = String(100, Chr$(0))
 
hwnd = FindWindow("tSkMainForm", vbNullString)
If hwnd > 0 Then
GetWindowText hwnd, MyStr, 100 ' Читаем заголовок Скайпа
MsgBox "Skype найден - " & MyStr
Else
MsgBox "Skype НЕ найден"
End If
 
End Sub

Option Explicit
 
Private Const IID_IDispatch     As String = "{00020400-0000-0000-C000-000000000046}"
Private Const IID_IHTMLElement  As String = "{3050f1ff-98b5-11cf-bb82-00aa00bdce0b}"
 
Private Const OBJID_CLIENT = -4
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExW" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As Long, ByVal lpsz2 As Long) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
 
Private Sub Form_Load()
    Dim ieWnd       As Long
    Dim i           As Long
    Dim IEObj       As Object
    Dim DispUUID    As UUID
    Dim HTMLUUID    As UUID
    Dim srv         As olelib2.IServiceProvider
    Dim Elem        As Object
    Dim logn        As Object
    Dim pswd        As Object
    Dim btn         As Object
    
    IIDFromString StrPtr(IID_IDispatch), DispUUID
    IIDFromString StrPtr(IID_IHTMLElement), HTMLUUID
    
    For i = 0 To 5
        ieWnd = FindWindowEx(ieWnd, 0, StrPtr(Choose(i + 1, _
                "TLoginForm", "TLoginControl", "TBrowserControl", _
                "Shell Embedding", "Shell DocObject View", "Internet Explorer_Server")), 0)
    Next
    
    If AccessibleObjectFromWindow(ieWnd, OBJID_CLIENT, DispUUID, IEObj) Then
        MsgBox "error": Exit Sub
    End If
    
    Set Elem = IEObj.accChild(CVar(CLng(0)))
    Set srv = Elem
    Set Elem = Nothing
    srv.QueryService HTMLUUID, DispUUID, i
    GetMem4 i, ByVal VarPtr(Elem)
    
    Set logn = Elem.All("username")
    logn.Value = "The trick"
    
    Set pswd = Elem.All("password")
    pswd.Value = "blblblblbl"
 
    Set btn = Elem.All("buttonSignIn")
    btn.Click
    
End Sub

Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long

Option Explicit
 
' Ïðèìåð ïðîãðàììíîãî ïîäêëþ÷åíèÿ Skype
' © Êðèâîóñ Àíàòîëèé Àíàòîëüåâè÷ (The trick), 2014
 
Private Const IID_IDispatch     As String = "{00020400-0000-0000-C000-000000000046}"
Private Const IID_IHTMLElement  As String = "{3050f1ff-98b5-11cf-bb82-00aa00bdce0b}"
 
Private Const OBJID_CLIENT      As Long = -4
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExW" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As Long, ByVal lpsz2 As Long) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
 
Private Sub Form_Load()
    Dim ieWnd       As Long                         ' Îêíà ñêàéïà
    Dim i           As Long                         ' Ñ÷åò÷èê
    Dim IEObj       As Object                       ' Îáúåêò IHTMLElement
    Dim DispUUID    As UUID                         ' UIID IDispatch
    Dim HTMLUUID    As UUID                         ' UIID IHTMLElement
    Dim srv         As olelib2.IServiceProvider     ' Äëÿ äîñòóïà ê IHTMLElement
    Dim Elem        As Object                       ' Òåëî HTML äîêóìåíòà
    Dim logn        As Object                       ' Ïîëå ââîäà ëîãèíà
    Dim pswd        As Object                       ' Ïîëå ââîäà ïàðîëÿ
    Dim btn         As Object                       ' Êíîïêà âõîäà
    ' Çàïîëíÿåì UIID'û
    IIDFromString StrPtr(IID_IDispatch), DispUUID
    IIDFromString StrPtr(IID_IHTMLElement), HTMLUUID
    ' Íàõîäèì íóæíîå íàì îêíî
    For i = 0 To 5
        ieWnd = FindWindowEx(ieWnd, 0, StrPtr(Choose(i + 1, _
                "TLoginForm", "TLoginControl", "TBrowserControl", _
                "Shell Embedding", "Shell DocObject View", "Internet Explorer_Server")), 0)
    Next
    ' Ïîëó÷àåì ññûëêó íà èíòåðôåéñ IAccessible, äëÿ äîñòóïà ê ýëåìåíòàì ñòðàíèöû
    If AccessibleObjectFromWindow(ieWnd, OBJID_CLIENT, DispUUID, IEObj) Then
        MsgBox "error": Exit Sub
    End If
    ' Ïîëó÷àåì òåëî äîêóìåíòà
    Set srv = IEObj.accChild(CVar(CLng(0)))
    ' Çàïðàøèâàåì èíòåðôåéñ IHTMLElement äëÿ äîñòóïà ê ñâîéñòâàì òåëà <BODY>
    srv.QueryService HTMLUUID, DispUUID, i
    GetMem4 i, ByVal VarPtr(Elem)
    ' Ââîäèì ëîãèí
    Set logn = Elem.All("username")
    logn.Value = "The trick"
    ' Ââîäèì ïàðîëü
    Set pswd = Elem.All("password")
    pswd.Value = "My password"
    ' Íàæèìàåì êíîïêó
    Set btn = Elem.All("buttonSignIn")
    btn.focus
    btn.Click
    ' Î÷èñòêà
    Set Elem = Nothing
    Set btn = Nothing
    Set pswd = Nothing
    Set logn = Nothing
End Sub

Set btn = Elem.All("buttonSignIn")