Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As LongPtr)
Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
'~~> Constants for pressing left button of the mouse
Const MOUSEEVENTF_LEFTDOWN As Long = &H2
'~~> Constants for Releasing left button of the mouse
Const MOUSEEVENTF_LEFTUP As Long = &H4
Const WM_SETTEXT As Long = &HC
Const BM_CLICK = &HF5
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim Ret As LongPtr, OpenRet As LongPtr, FlDwndHwnd As Long
Dim ChildRet As LongPtr
Dim strBuff As String, ButCap As String
Dim pos As RECT
Public IE As Object
Public h As LongPtr
Dim IeHandle As LongPtr
'~~> Use this if you want to specify your own name in the Save As Window
Const FileSaveAsName = "C:MyFile.csv"
Public Sub Wait(nSec As Double)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
Public Sub SendMess(Message As String, hwnd As LongPtr)
Call SendMessage(hwnd, WM_SETTEXT, False, ByVal Message)
End Sub
Public Sub CommandButton1_Click()
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Ret = FindWindow(vbNullString, "File Download")
If Ret <> 0 Then
MsgBox "Main Window Found"
'~~> Get the handle of the Button's "Window"
ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
ChildRet = FindWindowEx(Ret, ByVal 0&, "Bouton", vbNullString)
If ChildRet = 0 Then
MsgBox "Child Window Not Found"
Exit Sub
End If
'~~> Get the caption of the child window
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff
'~~> Loop through all child windows
Do While ChildRet <> 0
'~~> Check if the caption has the word "Save"
If InStr(1, ButCap, "Save") Then
'~~> If this is the button we are looking for then exit
OpenRet = ChildRet
Exit Do
End If
'~~> Get the handle of the next child window
ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
'~~> Get the caption of the child window
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff
Loop
'~~> Check if we found it or not
If OpenRet = 0 Then
MsgBox "The Handle of Save Button was not found"
Exit Sub
End If
'~~> Retrieve the dimensions of the bounding rectangle of the
'~~> specified window. The dimensions are given in screen
'~~> coordinates that are relative to the upper-left corner of the screen.
GetWindowRect OpenRet, pos
'~~> Move the cursor to the specified screen coordinates.
SetCursorPos (pos.Left - 10), (pos.Top - 10)
'~~> Suspends the execution of the current thread for a specified interval.
'~~> This give ample amount time for the API to position the cursor
Sleep 100
SetCursorPos pos.Left, pos.Top
Sleep 100
SetCursorPos (pos.Left + pos.Right) / 2, (pos.Top + pos.Bottom) / 2
'~~> Set the size, position, and Z order of "File Download" Window
SetWindowPos Ret, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
Sleep 100
'~~> Simulate mouse motion and click the button
'~~> Simulate LEFT CLICK
mouse_event MOUSEEVENTF_LEFTDOWN, (pos.Left + pos.Right) / 2, (pos.Top + pos.Bottom) / 2, 0, 0
Sleep 700
'~~> Simulate Release of LEFT CLICK
mouse_event MOUSEEVENTF_LEFTUP, (pos.Left + pos.Right) / 2, (pos.Top + pos.Bottom) / 2, 0, 0
Wait 10
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' START OF SAVEAS ROUTINE '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Ret = FindWindow(vbNullString, "Save As")
If Ret = 0 Then
MsgBox "Save As Window Not Found"
Exit Sub
End If
'~~> UNCOMMENT this if using IE6 and COMMENT the code for "DUIViewWndClassName"
'~~> "DirectUIHWND" and "FloatNotifySink"
' '~~> Get the handle of the Main ComboBox
' ChildRet = FindWindowEx(Ret, ByVal 0&, "ComboBoxEx32", "")
'
' If ChildRet = 0 Then
' MsgBox "ComboBoxEx32 Window Not Found"
' Exit Sub
' End If
ChildRet = FindWindowEx(Ret, ByVal 0&, "DUIViewWndClassName", "")
If ChildRet = 0 Then
MsgBox "DUIViewWndClassName Not Found"
Exit Sub
End If
ChildRet = FindWindowEx(ChildRet, ByVal 0&, "DirectUIHWND", "")
If ChildRet = 0 Then
MsgBox "DirectUIHWND Not Found"
Exit Sub
End If
ChildRet = FindWindowEx(ChildRet, ByVal 0&, "FloatNotifySink", "")
If ChildRet = 0 Then
MsgBox "FloatNotifySink Not Found"
Exit Sub
End If
'~~> Get the handle of the Main ComboBox
ChildRet = FindWindowEx(ChildRet, ByVal 0&, "ComboBox", "")
If ChildRet = 0 Then
MsgBox "ComboBox Window Not Found"
Exit Sub
End If
'~~> Get the handle of the Edit
ChildRet = FindWindowEx(ChildRet, ByVal 0&, "Edit", "")
If ChildRet = 0 Then
MsgBox "Edit Window Not Found"
Exit Sub
End If
'~~> COMMENT the below 3 lines if you do not want to specify a filename
Wait 10
SendMess FileSaveAsName, ChildRet
Wait 10
'~~> Get the handle of the Save Button in the Save As Dialog Box
ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
'~~> Check if we found it or not
If ChildRet = 0 Then
MsgBox "Save Button in Save As Window Not Found"
Exit Sub
End If
'~~> Get the caption of the child window
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff
'~~> Loop through all child windows
Do While ChildRet <> 0
'~~> Check if the caption has the word "Save"
If InStr(1, ButCap, "Save") Then
'~~> If this is the button we are looking for then exit
OpenRet = ChildRet
Exit Do
End If
'~~> Get the handle of the next child window
ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
'~~> Get the caption of the child window
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff
Loop
'~~> Check if we found it or not
If OpenRet = 0 Then
MsgBox "The Handle of Save Button in Save As Window was not found"
Exit Sub
End If
'~~> Save the file
SendMessage OpenRet, BM_CLICK, 0, ByVal 0&
Wait 10
Else
MsgBox "File Download Window Not found"
End If
Exit Sub
End Sub
Public Sub principal()
'Private Sub Populate_Click()
Dim i As Long
Dim objElement As Object
Dim objCollection As Object
Set IE = CreateObject("InternetExplorer.Application")
IeHandle = IE.hwnd
IE.Visible = True
IE.Navigate "http://tools.seobook.com/general/keyword-density/"
'Do Until IE.READYSTATE = READYSTATE_COMPLETE
'Loop
Do
DoEvents
Loop Until IE.READYSTATE = 3
Do
DoEvents
Loop Until IE.READYSTATE = 4
Set objCollection = IE.document.getElementsByTagName("textarea")
i = 0
For Each objets In objCollection
objets.InnerText = "http://www.bbc.com" 'nom page web
Next objets
With IE.document
Set elems = .getElementsByTagName("input")
For Each e In elems
If (e.className = "btn btn-primary pull-right") Then
e.Click
Exit For
End If
Next e
End With
Do
DoEvents
Loop Until IE.READYSTATE = 3
Do
DoEvents
Loop Until IE.READYSTATE = 4
'2eme page
With IE.document
Set elems = .getElementsByTagName("a")
For Each e In elems
If (e.className = "btn btn-small pull-right export") Then
e.Click
Call CommandButton1_Click
End If
Next e
End With
End Sub
