Closing File Select Dialog

closing a dialog window called from a process can have problems as the code will stop running while the dialog is open

a simple solution is a second exe file to find and close the dialog
compile this into a formless executable

Code:

---

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 GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal HWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal HWnd As Long) As Long

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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim Ret As Long, childret As Long, openret As Long
Dim strBuff As String, ButCap As String
Dim combo As Long

Const WM_SETTEXT = &HC
Const BM_CLICK = &HF5

Sub Main()
Dim wcap As String, bcap As String, upfile As String, params() As String, s As String, timeout As Long
params = Split(Command, "-")
wcap = Replace(Trim(params(0)), """", "")  ' window caption
bcap = Replace(Trim(params(1)), """", "")  ' button caption
upfile = Replace(Trim(params(2)), """", "") ' file path\name.ext to upload
' any of the above parameters that could contain spaces, must be enclosed in quotes by the calling application
' separate the parameters using - character
'timeout value can be altered if required as optional extra parameter
If UBound(params) = 3 Then timeout = Trim(params(3)) Else timeout = 15  ' 15 seconds
'MsgBox wcap & vbNewLine & bcap & vbNewLine & upfile
t = Timer

Do While Ret = 0 And Timer < t + timeout
DoEvents
    Ret = FindWindow(vbNullString, wcap)

    s = ""
    If Ret <> 0 Then
    Sleep 1000  ' let dialog load fully was not required in older OS

        '~~> Get the handle of the TextBox Window where we need to type the filename
        combo = FindWindowEx(Ret, ByVal 0&, "ComboBoxEx32", vbNullString)

        combo = FindWindowEx(combo, ByVal 0&, "Combobox", vbNullString)

        childret = FindWindowEx(combo, ByVal 0&, "Edit", vbNullString)

        If childret <> 0 Then
            'MsgBox "TextBox's Window Found"
            '~~> This is where we send the filename to the Text Window
            SendMess upfile, childret

            DoEvents

            '~~> Get the handle of the Button's "Window"
           
            childret = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)

            '~~> Check if we found it or not
            If childret <> 0 Then
                'MsgBox "Button's Window Found"

                '~~> 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 "OK"
                    If InStr(1, ButCap, bcap) 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
                    '~~> Click the OK Button
                    SendMessage childret, BM_CLICK, 0, vbNullString
                    s = "Window closed"
                Else
                    s = "The Handle of OK Button was not found"
                End If
            Else
                s = "Button's Window Not Found"
            End If
        Else
            s = "The Edit Box was not found"
        End If
    Else
        s = "Dialog Window was not Found"
    End If
Loop
'MsgBox s
End Sub

Sub SendMess(Message As String, HWnd As Long)
    Call SendMessage(HWnd, WM_SETTEXT, False, ByVal Message)
End Sub

---

this can then be shelled from any other code VB6, VBA and possibly VBS
using code like

Code:

---

Private Sub Command1_Click()
Dim wb As Object, params As String
Set wb = CreateObject("internetexplorer.application")
wb.navigate2 somesite  ' with file input element
wb.Visible = True
upfile = "c:\temp\list1.txt"  'file path to upload
params = """C:\Documents and Settings\user\timerclosedialog\closefiledialog2.exe"" ""Choose File to Upload-&Open-" & upfile & """"
'change path\filename above to the exe where you compile it
' change dialog caption and button caption if required
Shell params
DoEvents
wb.document.All("uploadedfile").Click    ' change to file input element on form
' end of testing, no further code used here
End Sub

---

you must shell the executable before displaying the dialog
the arguments passed when shelling the exe are separated by a - (spaces are not required, but will be ignored if present), 3 arguments are required, with an optional time out value
arguments are:-
dialog caption
button caption
filename to pass to dialog
timeout (optional)

dialog and button captions are language dependent and may possibly vary on other factors, which is why i made them to be passed as arguments

originally from http://www.vbforums.com/showthread.p...t=close+dialog