选择要上载的文件对话框。合并VBS和VBA流程

时间:2017-07-28 15:56:18

标签: vba internet-explorer vbscript ie-automation

您好我有两个程序:

  1. 单击按钮在IE中打开对话框
  2. 将数据输入到该对话框 他们两人分开工作
  3. 问题是如果对话框打开,VBA将不会进入第二个程序。 我认为解决方法是在vba之前启动vbs脚本(它包含与对话框的所有交互),它将解决自动化问题。

    我在VBA中都有这两个。这可行吗?如果是,我需要帮助来做VBS脚本。 另外如何将路径变量从VBA传递给VBS。

    第一部分:

    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
    

    第二部分:

    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
    

    测试vbs脚本只是为了关闭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
    

    其他使用此方法的人的功能

     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 个答案:

答案 0 :(得分:1)

所以,如果有人对这里的解决方案感兴趣,那就是(希望它对每个人都有帮助):

我使用VB6编译了.exe,它与上传文件对话框进行交互:

 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部分:

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