Sub Main_Module()
Const Txt_Path As String = "C:\iehelp.txt"
Const Dlg_Head As String = "Choose File to Upload"
Const Dlg_Butt_Name As String = "&Open"
Const M_URL As String = "http://mail.google.com"
Const M_User As String = ""
Const M_Pwd As String = ""
Dim OB_IE As SHDocVw.InternetExplorer
Dim OB_Doc As MSHTML.HTMLDocument
Dim EE_Anch As MSHTML.HTMLAnchorElement
Set OB_IE = New SHDocVw.InternetExplorer
OB_IE.Visible = True
OB_IE.Navigate M_URL
Do Until OB_IE.ReadyState = READYSTATE_COMPLETE
Loop
Set OB_Doc = OB_IE.Document
OB_Doc.all.Item("Email").Value = M_User
OB_Doc.all.Item("Passwd").Value = M_Pwd
OB_Doc.all.Item("signIn").Click
Do Until OB_IE.ReadyState = READYSTATE_COMPLETE
Loop
Application.Wait (Now + TimeValue("00.00.45"))
For Each EE_Anch In OB_Doc.all
If EE_Anch.href = "https://mail.google.com/mail/?ui=html&zy=s" Then
EE_Anch.Click
Exit For
End If
Next
Do Until OB_IE.ReadyState = READYSTATE_COMPLETE
Loop
Application.Wait (Now + TimeValue("00.00.20"))
For Each EE_Anch In OB_Doc.all
If Len(EE_Anch.href) > 16 Then
If Right(EE_Anch.href, 16) = "?&v=b&pv=tl&cs=b" Then
EE_Anch.Click
Exit For
End If
End If
Next
Do Until OB_IE.ReadyState = READYSTATE_COMPLETE
Loop
Application.Wait (Now + TimeValue("00.00.20"))
Dim S_FSO As Object
Dim S_TxtFile As Object
Set S_FSO = CreateObject("Scripting.filesystemobject")
If S_FSO.fileexists(Txt_Path) = True Then
Set S_TxtFile = S_FSO.opentextfile(Txt_Path, 2)
Else
Set S_TxtFile = S_FSO.createtextfile(Txt_Path)
End If
Dim Upload_File As String
Upload_File = "C:\test.txt"
S_TxtFile.write Dlg_Head & ";;" & Dlg_Butt_Name & ";;" & Upload_File
S_TxtFile.Close
Set S_TxtFile = Nothing
Set S_FSO = Nothing
Dim R_Shl As Double
R_Shl = Shell("wscript.exe C:\iehelp.vbs")
OB_Doc.all("file0").Click
Set EE_Anch = Nothing
Set OB_Doc = Nothing
Set OB_IE = Nothing
End Sub
Dim t_wait
t_wait = now + timevalue("00.00.10")
Do Until now > t_wait
Loop
Dim xl_app
Dim wk_ie
Set xl_app = createobject("Excel.Application")
Set wk_ie = xl_app.workbooks.open("C:\iehelp.xls")
wk_ie.close
Set wk_ie = Nothing
xl_app.quit
Set xl_app = Nothing
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetNextWindow Lib "user32" Alias _
"GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
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 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 FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const WIN_ClassName_FilePath As String = "COMBOBOXEX32"
Private Const WIN_ClassName_Button As String = "BUTTON"
Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5
Private Const WIN_NEXT As Long = 2
Private Const WIN_PREVIOUS As Long = 3
Private Sub Workbook_Open()
Main_SetPath
End Sub
Private Sub Main_SetPath()
Const T_Path As String = "C:\iehelp.txt"
Dim WIN_Dialog As Long
Dim Dlg_ChildWIN As Long
Dim Dialog_Caption As String
Dim Dlg_Retun As Long
Dim File_Path As String
Dim ButtonTxt As String
Dim Same_Window As Long
Dim FSO As Object
Dim T_M As Object
Dim Tl_Str() As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set T_M = FSO.opentextfile(T_Path)
Tl_Str = Split(T_M.readall, ";;")
T_M.Close
Set T_M = Nothing
Set FSO = Nothing
Dialog_Caption = Tl_Str(0)
ButtonTxt = Tl_Str(1)
File_Path = Tl_Str(2)
WIN_Dialog = 0
WIN_Dialog = FindWindow(vbNullString, Dialog_Caption)
If WIN_Dialog = 0 Then
MsgBox "Cannot find dialog box named '" & Dialog_Caption & _
"' make sure dialogbox open or change to your suit"
Exit Sub
End If
Same_Window = Find_WindowDuplicte(WIN_Dialog, Dialog_Caption)
If Same_Window <> 0 Then
MsgBox "More than one windows opened in the name of '" & _
Dialog_Caption & "' Please check and close one"
Exit Sub
End If
Dlg_ChildWIN = FindWindowEx(WIN_Dialog, 0, WIN_ClassName_FilePath, vbNullString)
If Dlg_ChildWIN <> 0 Then
Dlg_Retun = SendMessage(Dlg_ChildWIN, WM_SETTEXT, 0, ByVal File_Path)
If Dlg_Retun <> 1 Then
MsgBox "Path Not set please try again"
Exit Sub
End If
Else
MsgBox "File path window not found"
Exit Sub
End If
Dlg_ChildWIN = FindWindowEx(WIN_Dialog, 0, WIN_ClassName_Button, ButtonTxt)
If Dlg_ChildWIN <> 0 Then
SendMessage Dlg_ChildWIN, BM_CLICK, 0, 0
Else
MsgBox "Button window not found"
Exit Sub
End If
End Sub
Private Function Find_WindowDuplicte(Main_Hwnd As Long, WIN_Caption As String) As Long
Dim Ser_Win As Long
Dim TxtLen_Win As Long
Dim Txt_Win As String
Dim Ret_Txt As Long
Find_WindowDuplicte = 0
Ser_Win = GetNextWindow(Main_Hwnd, WIN_NEXT)
If Ser_Win = 0 Then Exit Function
Do Until Ser_Win = 0
TxtLen_Win = GetWindowTextLength(Ser_Win)
TxtLen_Win = TxtLen_Win + 1
Txt_Win = Space$(TxtLen_Win)
Ret_Txt = GetWindowText(Ser_Win, Txt_Win, TxtLen_Win)
If Ret_Txt > 0 Then
Txt_Win = UCase(Left(Txt_Win, Ret_Txt))
End If
If Txt_Win = UCase(WIN_Caption) Then
Find_WindowDuplicte = Ser_Win
Exit Function
End If
Ser_Win = GetNextWindow(Ser_Win, WIN_NEXT)
Loop
Ser_Win = GetNextWindow(Main_Hwnd, WIN_PREVIOUS)
If Ser_Win = 0 Then Exit Function
Do Until Ser_Win = 0
TxtLen_Win = GetWindowTextLength(Ser_Win)
Txt_Win = Space$(TxtLen_Win)
Ret_Txt = GetWindowText(Ser_Win, Txt_Win, TxtLen_Win)
If Ret_Txt > 0 Then
Txt_Win = UCase(Left(Txt_Win, Ret_Txt))
End If
If Txt_Win = UCase(WIN_Caption) Then
Find_WindowDuplicte = Ser_Win
Exit Function
End If
Ser_Win = GetNextWindow(Ser_Win, WIN_PREVIOUS)
Loop
End Function
|