internet explorer - Choose file to upload dialog. Merge VBS and VBA process -
hi have 2 procedures:
- click button open dialog box in ie
- to enter data dialog box both of them work seperatly
the problem vba wont proceed 2nd procedure if dialog box open. think work around launch vbs script (which holds interaction dialog box) prior vba , solve automation problem.
i have both of them in vba. feasable? if yes need vbs script. how pass path variable vba vbs.
1st part:
sub matchwww() marker = 0 set ie = createobject("internetexplorer.application") set objshell = createobject("shell.application") ie_count = objshell.windows.count x = 0 (ie_count - 1) on error resume next ' more web pages counted open my_url = objshell.windows(x).document.location my_title = objshell.windows(x).document.title if my_title "invoice submission" & "*" 'compare find if desired web page open set ie = objshell.windows(x) marker = 1 exit else end if next 'dim html htmldocument if marker = 0 msgbox ("a matching webpage not found") else set html = ie.document 'call uploadfileautomation msgmarker = 0 each msg_not in html.getelementsbyclassname("ripsstdtxtbox") msg_not.click next msg_not end if ' end if of matchwww main statement end sub 2nd part:
sub uploadfileautomation() saveaswindow = findwindow(vbnullstring, "choose file upload") if saveaswindow = 0 msgbox "couldn't find saveaswindow" end if textcombobox = findwindowex(saveaswindow, 0&, "comboboxex32", vbnullstring) if saveaswindow = 0 msgbox "couldn't find saveaswindow" end if combobox = findwindowex(textcombobox, 0&, "combobox", vbnullstring) if combobox = 0 msgbox "couldn't find combobox" end if editcombobox = findwindowex(combobox, 0&, "edit", vbnullstring) if editcombobox = 0 msgbox "couldn't find 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 close box
set wshshell = createobject("wscript.shell") ret = wshshell.appactivate("choose file upload") loop until ret = true wscript.sleep 5 ret = wshshell.appactivate("choose file upload") if ret= true ret = wshshell.appactivate("choose file upload") wscript.sleep 10 wshshell.sendkeys "%{f4}" end if functions other use approach
public declare ptrsafe function findwindow lib "user32.dll" alias "findwindowa" (byval lpclassname string, byval lpwindowname string) long public declare ptrsafe function sendmessage lib "user32.dll" alias "sendmessagea" (byval hwnd long, byval wmsg long, byval wparam long, byref lparam any) long public declare ptrsafe function findwindowex lib "user32.dll" alias "findwindowexa" (byval hwnd1 long, byval hwnd2 long, byval lpsz1 string, byval lpsz2 string) long public declare ptrsafe function sendmessagebystring lib "user32.dll" alias "sendmessagea" (byval hwnd long, byval wmsg long, byval wparam long, byval lparam any) long public declare ptrsafe function setactivewindow lib "user32.dll" (byval hwnd long) long public declare ptrsafe function showwindow lib "user32" (byval hwnd long, byval ncmdshow long) long public declare ptrsafe function bringwindowtotop lib "user32" (byval lnghwnd long) long public declare ptrsafe function enablewindow lib "user32.dll" (byval hwnd long, byval fenable long) long public declare ptrsafe function getactivewindow lib "user32" () long public declare ptrsafe function getfocus lib "user32.dll" () long public const wm_close long = &h10 public const sw_show integer = 5 public const wm_settext long = &hc public const bm_click long = &hf5&
so if interested in solution here it's(hope helps everybody):
i compiled .exe vb6 interacts upload file dialog:
private declare function findwindow lib "user32.dll" alias "findwindowa" (byval lpclassname string, byval lpwindowname string) long private declare function sendmessage lib "user32.dll" alias "sendmessagea" (byval hwnd long, byval wmsg long, byval wparam long, byref lparam any) long private declare function findwindowex lib "user32.dll" alias "findwindowexa" (byval hwnd1 long, byval hwnd2 long, byval lpsz1 string, byval lpsz2 string) long private declare function sendmessagebystring lib "user32.dll" alias "sendmessagea" (byval hwnd long, byval wmsg long, byval wparam long, byval lparam any) long private declare function setactivewindow lib "user32.dll" (byval hwnd long) long private declare function showwindow lib "user32" (byval hwnd long, byval ncmdshow long) long private declare function bringwindowtotop lib "user32" (byval lnghwnd long) long private declare function enablewindow lib "user32.dll" (byval hwnd long, byval fenable long) long private declare function getactivewindow lib "user32" () long private declare function getfocus lib "user32.dll" () long private declare sub sleep lib "kernel32.dll" (byval dwmilliseconds long) private const wm_close long = &h10 private const sw_show integer = 5 private const wm_settext long = &hc private const bm_click long = &hf5& public sub main() 'is nessesary execute on launch dim strcommandline string 'path passed vba strcommandline = command 'path passed vba sleep 25000 'wait execute, can smarter way check if dialog open saveaswindow = findwindow(vbnullstring, "choose file upload") if saveaswindow = 0 msgbox "couldn't find saveaswindow" 'msg boxes troubleshooting see if right elements found or not end if textcombobox = findwindowex(saveaswindow, 0&, "comboboxex32", vbnullstring) if saveaswindow = 0 msgbox "couldn't find saveaswindow" end if combobox = findwindowex(textcombobox, 0&, "combobox", vbnullstring) if combobox = 0 msgbox "couldn't find combobox" end if editcombobox = findwindowex(combobox, 0&, "edit", vbnullstring) if editcombobox = 0 msgbox "couldn't find editcombobox" end if ''and wait/sleep call sendmessagebystring(editcombobox, wm_settext, 0, strcommandline) 'here goes variable 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 string dim strargument 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 x = 0 (ie_count - 1) on error resume next ' more web pages counted open my_url = objshell.windows(x).document.location my_title = objshell.windows(x).document.title if my_title "invoice submission" & "*" 'compare find if desired web page open set ie = objshell.windows(x) marker = 1 exit else end if next 'dim html htmldocument if marker = 0 msgbox ("a matching webpage not found") else set html = ie.document msgmarker = 0 call shell("""" & strprogramname & """ """ & strargument & """", vbnormalfocus) 'we need call prior dialog open each msg_not in html.getelementsbyclassname("ripsstdtxtbox") 'here opening dialog msg_not.click next msg_not end if ' end if of matchwww main statement end sub 
Comments
Post a Comment