2017-07-28 19 views
1

嗨,我有兩個步驟:選擇要上傳對話框的文件。合併VBS和VBA過程

  1. 點擊按鈕,在IE
  2. 打開對話框
  3. 將數據輸入到對話框 他們兩人的工作seperatly

的問題是如果對話框打開,VBA不會繼續執行第二個過程。 我認爲解決方法是在vba之前啓動vbs腳本(其中包含與對話框的所有交互),它將解決自動化問題。

我有他們在VBA。這是可行的嗎?如果是的話,我需要幫助做VBS腳本。 另外如何將路徑變量從VBA傳遞給VBS。

第1部分:

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 

第2部分:

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& 
+0

因此,在閱讀了很多內容之後,似乎無法在沒有解決方法的VBS腳本中使用user32.dll。也許它可能寫在VB6中。 –

+0

問題被標記爲接受答案解決。如果你需要,你可以添加你的解決方案作爲你自己問題的答案,然後接受你自己的答案。請不要通過更改標題或內容以包含「解決」一詞來破壞任何問題。 –

回答

1

所以,如果有人有興趣的解決方案在這裏它的(希望它可以幫助大家):

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 

我用VB6與上傳文件對話框交互編譯的.exe

相關問題