Option Compare Database
Option Explicit
Public AccHnd As Long
Public IEWindow As Long
'declares the imported API functions that are used in this example:
'http://en.wikipedia.org/wiki/API
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 GetCurrentProcessId Lib "kernel32" () As Long
Private 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 GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) 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 SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
'declares a constant that's used by PostMessage()... this specific message is
'ButtonMessage_CLICK (ie: message sent to click on the button)
Private Const BM_CLICK = &HF5
Private Const WM_SETTEXT = &HC
Private Const MYTIMER_ID = 112
Public Declare Function SetTimer Lib "user32" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Dim timerId As Long
Public Sub BeginTimer(ByVal ms As Long, ByVal Access_Hnd As Long)
AccHnd = Access_Hnd
If timerId = 0 Then
timerId = SetTimer(0, MYTIMER_ID, ms, AddressOf TimerProc)
End If
End Sub
Public Sub EndTimer()
If KillTimer(0, timerId) <> 0 Then
timerId = 0
End If
End Sub
Public Sub TimerProc( _
ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
Debug.Print "Timer"
Dim wnd1 As Long, wnd2 As Long, wnd3 As Long, wnd4 As Long, wnd5 As Long
'wnd1 = FindWindow("#32770", "Windows Internet Explorer")
wnd1 = IEWindow
Dim windowTitle As String
windowTitle = Space(100)
Dim titleLength As Long
titleLength = GetWindowText(wnd1, windowTitle, 100)
Debug.Print "wnd1's address is " & wnd1 & ", and it's Title is = " & Left(windowTitle, titleLength)
Dim counter As Integer
If (wnd1 <> 0) Then
Do
counter = counter + 1
wnd2 = FindWindowEx(wnd1, 0&, vbNullString, vbNullString)
titleLength = GetWindowText(wnd2, windowTitle, 100)
Debug.Print "child " & counter & " address = " & wnd2 & ", and it's Title is = " & Left(windowTitle, titleLength)
wnd1 = wnd2
Loop Until InStr(windowTitle, "microsoft internet explorer") <> 0 _
Or counter > 50
End If
' If (wnd1 <> 0) Then
' If (GetParent(wnd1) = AccHnd) Then
' wnd3 = FindWindowEx(wnd1, 0, "Button", "OK")
' Debug.Print "wnd3 " & wnd3
'
' If (wnd3 <> 0) Then
' Call PostMessage(wnd3, BM_CLICK, 0, 0)
' End If
' End If
' End If
EndTimer
End Sub
Public Sub DA_Login()
Dim IE As InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "[URL]https://hr.direct-access.us/servlets/iclientservlet/USCGP1HR/?cmd=login[/URL]"
'enter the user ID
Do: Loop Until Not IE.Busy
Do While InStr(IE.Document.documentElement.innerText, "User ID") = 0
Loop
IE.Document.all("userid").Value = 1234567
'enter the password
Do: Loop Until Not IE.Busy
Do While InStr(IE.Document.documentElement.innerText, "Password") = 0
Loop
IE.Document.all("pwd").Value = "mySecretPassword"
IEWindow = IE.hWnd
Call BeginTimer(1500, Application.hWndAccessApp)
'press the submit button
IE.Document.all("Submit").Click
Exit_DA_Login:
Exit Sub
End Sub
