復(fù)制一下代碼涩金，修改對應(yīng)的地址及相關(guān)參數(shù)，粘貼至文本遂赠，另存為vbs文件桐罕，運行即可
1.png
DDAY="2020-08-01/":Const strWindowTitle = "文件下載":Const LCWTitle = "另存為"
for i=1 to 3 '導(dǎo)出幾個系統(tǒng)的數(shù)據(jù)，此處就是幾
select case i
case 1
SS=4:cxan="Button2":dcan="Button1"
URL="http://192.168.1.1/dms/Login.aspx":username = "用戶名1":password = "密碼1"
case 2
SS=1: cxan="Button2":dcan="Button1"
URL="http://192.168.1.2/dms/Login.aspx":username = "用戶名2":password = "密碼2"
case 3
SS=2:cxan="Button2":dcan="Button1"
URL="http://192.168.1.3/Login.aspx":username = "用戶名3":password = "密碼3"
end select
'----------------------------以上登錄系統(tǒng)參數(shù)設(shè)置----------username網(wǎng)頁源代碼的ID----password同理----------------
Set IE =CreateObject("InternetExplorer.Application")
IE.visible = false
IE.Navigate URL
Do while IE.ReadyState<> 4 or IE.busy
wscript.sleep 2000
loop
IE.document.form1.UserName.value=username '填寫賬號
IE.document.form1.Password.value=password '填寫密碼
IE.document.getElementById("Btok").click() '點擊登錄按鈕
Do while IE.ReadyState<> 4 or IE.busy
wscript.sleep 2000
loop
'----------------------------以上登錄系統(tǒng)環(huán)節(jié)------------------------------
for n=1 to SS '導(dǎo)出具體數(shù)據(jù)
if i=1 and n=1 then UR="http://192.168.1.1/dms/webserch/web_mjc_0008/?id=2879":nam="本月.xls"
if i=1 and n=2 then UR="http://192.168.1.1/dms/webserch/web_mjc_0004/?id=2441":nam="庫存.xls"
if i=1 and n=3 then UR="http://192.168.1.1/dms/webserch/web_mjc_0001/?id=3039" :nam="資源.xls"
if i=1 and n=4 then UR="http://192.168.1.1/dms/webserch/web_mjc_0004/?id=2437":nam="自由.xls"
if i=2 and n=1 then UR="http://192.168.1.2/dms/webserch/web_mjc_0001/?id=3050" :nam="未交.xls"
if i=3 and n=1 then UR="http://192.168.1.3/webserch/web_mjc_0008/?id=78" :nam="雙證.xls"
if i=3 and n=2 then UR="http://192.168.1.3/webserch/web_mjc_0008/?id=77" :nam="單證.xls"
IE.Navigate UR
IE.visible = true
Do while IE.ReadyState<> 4 or IE.busy
wscript.sleep 2000
loop
Set ddc = IE.document.getElementsBytagName("input")
Set dec = IE.document.getElementsBytagName("td")
if i=1 and n=1 then IE.document.form1.text4.value=DDAY '填寫查詢條件
if i=1 and n=4 then ddc(2).value=DDAY '自由
if i=3 and n=1 then IE.document.form1.text5.value=DDAY:IE.document.form1.text2.value="XLC" '雙證
if i=3 and n=2 then IE.document.form1.text9.value=DDAY:IE.document.form1.text2.value="XLC" '單證
'IE.document.getElementById(cxan).click() '點擊查詢
IE.document.getElementById(dcan).click() '點擊導(dǎo)出
'A=msgbox ("發(fā)現(xiàn)瀏覽器閃爍或下載框出現(xiàn)了沒功炮？",4,"下載確認(rèn)")
'----------------------------下載環(huán)節(jié)-----------------------------
Dim wso, fso
Set wso = CreateObject("Wscript.Shell")
Set fso=CreateObject("Scripting.FileSystemObject")
Do While wso.AppActivate(strWindowTitle) = False
WScript.sleep 500 ' 延時 1 秒
Loop
Call WindowActive(strWindowTitle) '激活下載窗口
WScript.sleep 500 ' 延時 1 秒
wso.SendKeys "%S" '發(fā)送alt+S 保存
WScript.sleep 1000 ' 延時1 秒
Set Word = CreateObject("Word.Application")
Word.Documents.Add
Word.Selection.Text = nam
Word.Selection.Copy '復(fù)制文件名
Word.Quit False
Call LCWActive(LCWTitle) '激活另存
WScript.sleep 2000 ' 延時 1 秒
wso.SendKeys "^v" '粘貼文件名
WScript.sleep 500 ' 延時 1 秒
wso.sendkeys "%S" '發(fā)送alt+S 保存
WScript.sleep 1000 ' 延時 1 秒
wso.SendKeys "%Y" '發(fā)送Y 覆蓋已有
WScript.sleep 500 ' 延時 1 秒
'if i=3 and n=2 then wso.Run "轉(zhuǎn)換文本.vbs"
Set wso = NoThing
next
next
'------------------------------------------------------------
Sub LCWActive(ByVal LCWTitle)'激活另存為窗口
Dim objWord, objTasks
Set objWord = CreateObject("word.Application")
Set objTasks = objWord.Tasks
DO Until objTasks.Exists(LCWTitle)
objTasks(LCWTitle).Activate
objTasks(LCWTitle).WindowState = 1 '0平常模式溅潜、1最大化模式、2最小化模式
Exit Do
loop
objWord.Quit
End Sub
'------------------------------------------------------------
Sub WindowActive(ByVal strWindowTitle)'激活下載窗口
Dim objWord, objTasks
Set objWord = CreateObject("word.Application")
Set objTasks = objWord.Tasks
DO Until objTasks.Exists(strWindowTitle)
objTasks(strWindowTitle).Activate
objTasks(strWindowTitle).WindowState = 1 '0平常模式薪伏、1最大化模式滚澜、2最小化模式
Exit Do
loop
objWord.Quit
End Sub
