Power bi需要导出数据---VBS自动导出系统数据代码

复制一下代码，修改对应的地址及相关参数，粘贴至文本，另存为vbs文件，运行即可

填写参数需要到网页的源代码中找ID，如图：

1.png

DDAY="2020-08-01/":Const strWindowTitle = "文件下载":Const LCWTitle = "另存为"
for i=1 to 3      '导出几个系统的数据，此处就是几
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
'----------------------------以上登录系统参数设置----------username网页源代码的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
'----------------------------以上登录系统环节------------------------------
for n=1 to SS   '导出具体数据
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()   '点击导出
'A=msgbox ("发现浏览器闪烁或下载框出现了没？",4,"下载确认")
'----------------------------下载环节-----------------------------
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"    '发送alt+S   保存
  WScript.sleep 1000    ' 延时1 秒
  Set Word = CreateObject("Word.Application")
  Word.Documents.Add
  Word.Selection.Text = nam    
  Word.Selection.Copy     '复制文件名
  Word.Quit False
  Call LCWActive(LCWTitle)     '激活另存
  WScript.sleep 2000    ' 延时 1 秒  
  wso.SendKeys "^v"     '粘贴文件名
  WScript.sleep 500    ' 延时 1 秒  
  wso.sendkeys "%S"   '发送alt+S   保存
  WScript.sleep 1000    ' 延时 1 秒  
 wso.SendKeys "%Y"     '发送Y   覆盖已有
  WScript.sleep 500    ' 延时 1 秒  
'if i=3 and n=2 then  wso.Run "转换文本.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