问题
Hi i have two procedures:
- Click button to open dialog box in IE
- To enter data to that dialog box Both of them work seperatly
The problem is that VBA wont proceed to 2nd procedure if dialog box is open. I think work around would be to launch vbs script (which holds all interaction with dialog box) prior to vba and it would solve automation problem.
I have both of them in VBA. So is this feasable? If yes I would need help to do VBS script. Also how to pass path variable from VBA to VBS.
1st part:
Sub matchwww()
marker = 0
Set IE = CreateObject("InternetExplorer.Application")
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_url = objShell.Windows(x).Document.Location
my_title = objShell.Windows(x).Document.Title
If my_title Like "Invoice Submission" & "*" Then 'compare to find if the desired web page is already open
Set IE = objShell.Windows(x)
marker = 1
Exit For
Else
End If
Next
'Dim html As HTMLDocument
If marker = 0 Then
MsgBox ("A matching webpage was NOT found")
Else
Set html = IE.Document
'Call UploadfileAutomation
msgmarker = 0
For Each msg_not In html.getElementsByClassName("ripsStdTxtBox")
msg_not.Click
Next msg_not
End If ' this End If of matchwww main statement
End Sub
2nd part:
Sub UploadfileAutomation()
SaveAsWindow = FindWindow(vbNullString, "Choose file to Upload")
If SaveAsWindow = 0 Then
MsgBox "Couldn't find the SaveAsWindow"
End If
TextComboBox = FindWindowEx(SaveAsWindow, 0&, "ComboBoxEx32", vbNullString)
If SaveAsWindow = 0 Then
MsgBox "Couldn't find the SaveAsWindow"
End If
ComboBox = FindWindowEx(TextComboBox, 0&, "ComboBox", vbNullString)
If ComboBox = 0 Then
MsgBox "Couldn't find the ComboBox"
End If
EditComboBox = FindWindowEx(ComboBox, 0&, "Edit", vbNullString)
If EditComboBox = 0 Then
MsgBox "Couldn't find the EditComboBox"
End If
''and wait/sleep
Call SendMessageByString(EditComboBox, WM_SETTEXT, 0, "Path variable")
DoEvents
SaveButton = FindWindowEx(SaveAsWindow, 0&, "Button", "&Open")
Call EnableWindow(SaveButton, True)
Call SendMessage(SaveButton, BM_CLICK, 0&, ByVal 0&)
End Sub
test vbs script just to close BOX
Set wshShell = CreateObject("WScript.shell")
Do
ret = wshShell.appActivate("Choose file to upload")
Loop until ret = True
Wscript.sleep 5
ret = wshShell.appActivate("Choose file to upload")
if ret= true then
ret = wshShell.appActivate("Choose file to upload")
Wscript.sleep 10
wshShell.sendkeys "%{F4}"
End if
Functions for other who would use this approach
Public Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Public Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare PtrSafe Function SendMessageByString Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Public Declare PtrSafe Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdSHow As Long) As Long
Public Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal lngHWnd As Long) As Long
Public Declare PtrSafe Function EnableWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Public Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
Public Declare PtrSafe Function GetFocus Lib "user32.dll" () As Long
Public Const WM_CLOSE As Long = &H10
Public Const SW_SHOW As Integer = 5
Public Const WM_SETTEXT As Long = &HC
Public Const BM_CLICK As Long = &HF5&
回答1:
So if anybody is interested in solution here it's(hope it helps everybody):
I compiled .exe with VB6 which interacts with Upload File dialog:
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessageByString Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdSHow As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal lngHWnd As Long) As Long
Private Declare Function EnableWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetFocus Lib "user32.dll" () As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const WM_CLOSE As Long = &H10
Private Const SW_SHOW As Integer = 5
Private Const WM_SETTEXT As Long = &HC
Private Const BM_CLICK As Long = &HF5&
Public Sub Main() 'is nessesary to execute on launch
Dim strCommandLine As String 'path passed from VBA
strCommandLine = Command 'path passed from VBA
Sleep 25000 'wait to execute, can be smarter way to check if dialog is already open
SaveAsWindow = FindWindow(vbNullString, "Choose file to Upload")
If SaveAsWindow = 0 Then
MsgBox "Couldn't find the SaveAsWindow" 'msg boxes are just for troubleshooting to see if right elements are found or not
End If
TextComboBox = FindWindowEx(SaveAsWindow, 0&, "ComboBoxEx32", vbNullString)
If SaveAsWindow = 0 Then
MsgBox "Couldn't find the SaveAsWindow"
End If
ComboBox = FindWindowEx(TextComboBox, 0&, "ComboBox", vbNullString)
If ComboBox = 0 Then
MsgBox "Couldn't find the ComboBox"
End If
EditComboBox = FindWindowEx(ComboBox, 0&, "Edit", vbNullString)
If EditComboBox = 0 Then
MsgBox "Couldn't find the EditComboBox"
End If
''and wait/sleep
Call SendMessageByString(EditComboBox, WM_SETTEXT, 0, strCommandLine) 'here goes variable from VBA "strCommandLine"
DoEvents
SaveButton = FindWindowEx(SaveAsWindow, 0&, "Button", "&Open")
Call EnableWindow(SaveButton, True)
Call SendMessage(SaveButton, BM_CLICK, 0&, ByVal 0&)
End Sub
VBA Part:
Sub matchwww()
marker = 0
Dim strProgramName As String
Dim strArgument As String
strProgramName = ThisWorkbook.Path & "\UploadInvoice.exe"
strArgument = "I:\testetetstest.xls"
Set IE = CreateObject("InternetExplorer.Application")
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_url = objShell.Windows(x).Document.Location
my_title = objShell.Windows(x).Document.Title
If my_title Like "Invoice Submission" & "*" Then 'compare to find if the desired web page is already open
Set IE = objShell.Windows(x)
marker = 1
Exit For
Else
End If
Next
'Dim html As HTMLDocument
If marker = 0 Then
MsgBox ("A matching webpage was NOT found")
Else
Set html = IE.Document
msgmarker = 0
Call Shell("""" & strProgramName & """ """ & strArgument & """", vbNormalFocus) 'we need to call prior dialog is open
For Each msg_not In html.getElementsByClassName("ripsStdTxtBox") 'here we are opening dialog
msg_not.Click
Next msg_not
End If ' this End If of matchwww main statement
End Sub
来源：https://stackoverflow.com/questions/45377777/choose-file-to-upload-dialog-merge-vbs-and-vba-process