Excel使用VBS和批处理下载文件，无法从VBS下载文件

Question

你好 Stacked Overflow 社区，

以前有人问过这个问题，但没有涉及到一个特定的元素； 自动化通过 VBS

1. 总而言之，我希望每天自动下载一个文件
2. 有一个已知的用户名和密码
3. 下载文件来自一个没有关联 URL 的实际按钮 (HTMLButton.Click)
4. 我正在使用 SendKeys 执行保存文件操作以通过“您要打开还是保存文件”窗口
5. 在宏中执行时一切正常（从 Excel 运行）；
6. 但是，我希望它能够与 Windows 任务计划程序一起运行，并且我已经编写了一个批处理文件，该批处理文件调用了上述的 Visual Basic 脚本，当然在第 4 步中中断

批号：

@echo off
echo Success! Code ALG_Excel_01 %date:~-10,2%.%date:~-7,2%.%date:~-2,2% ^& %time:~0,8% >> "C:\Users\dchacon\Desktop\ALG_DCCS02\Logs_DCCS02.txt"
cscript C:\Users\dchacon\Desktop\ALG_DCCS02\ALG_Excel_01.vbs
timeout 7
exit

VBS 代码：

Dim objExcel, objWB
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

Set objWB = ObjExcel.Workbooks.Open("C:\Users\dchacon\Desktop\ALG_DCCS02\ALG_Triple_Check.xlsm")
ObjWB.Application.Run("ExportSequence")

objExcel.DisplayAlerts = False
'Set ObjExcel = Nothing
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
'WScript.Echo "Finished."
'WScript.Quit

VBA 代码：

Sub ExportSequence()
    
    Dim ie As New SHDocVw.InternetExplorer
    Dim HTMLDoc As MSHTML.HTMLDocument
    Dim HTMLLogin As MSHTML.IHTMLElement
    Dim HTMLPassword As MSHTML.IHTMLElement
    Dim HTMLButton As MSHTML.IHTMLElement
    Dim HTMLFrom As MSHTML.IHTMLElement
    Dim HTMLTo As MSHTML.IHTMLElement
    Dim HTMLJob As MSHTML.IHTMLElement
    Dim HTMLName As MSHTML.IHTMLElement
    Dim URL As String
    
    URL = "https://Vendor_Website.com/login.aspx"
    ie.Visible = True
    ie.navigate URL
    
    Do While ie.ReadyState <> ReadyState_Complete
    Loop
    
    Set HTMLDoc = ie.Document
    Set HTMLLogin = HTMLDoc.getElementById("ctl00$ContentPlaceHolder1$uxAlgLogin$txtUserName")
    Set HTMLPassword = HTMLDoc.getElementById("ctl00$ContentPlaceHolder1$uxAlgLogin$txtPassword")
    HTMLLogin.Value = "UserName"
    HTMLPassword.Value = "Password"

    Set HTMLButton = HTMLDoc.getElementById("ContentPlaceHolder1_uxAlgLogin_lnkLogin")
    HTMLButton.Click
    
    Do While ie.ReadyState <> ReadyState_Complete
    Loop
    
    Application.Wait (Now + TimeValue("0:00:03"))
    
    '****New Logic**********
    Set HTMLFrom = HTMLDoc.getElementById("ContentPlaceHolder1_txtPoolDateStart")
    Set HTMLTo = HTMLDoc.getElementById("ContentPlaceHolder1_txtPoolDateEnd")
    Set HTMLJob = HTMLDoc.getElementById("ContentPlaceHolder1_txtJobNum")
    Set HTMLName = HTMLDoc.getElementById("ContentPlaceHolder1_txtJobName")
    
    Application.Wait (Now + TimeValue("0:00:02"))
    
    HTMLFrom.Value = "1/01/2021"
    HTMLTo.Value = "7/30/2021"
    'HTMLJob.Value = str_Job
    'HTMLName.Value = str_Name
    
    '***Search Button****
    Set HTMLButton = HTMLDoc.getElementById("btnSearch")
    HTMLButton.Click
    
    Do While ie.ReadyState <> ReadyState_Complete
    Loop
        
    '***Export Button Sequence***
    Set HTMLButton = HTMLDoc.getElementById("ContentPlaceHolder1_btnExport")
    HTMLButton.Click
    
    Application.Wait (Now + TimeValue("0:00:08"))
    'Debug.Print ie.ReadyState, ie.Application, ie.Document, ie.Container
    
    'Application.SendKeys "%{S}"
    SendKeys "%S"
    'Call Download
    
End Sub

我同时输入了 Do while ReadyState_Complete 和 Application.Wait，我知道这是多余的，但代码在整个过程中运行良好。最大的问题是当我通过 VBS 调用代码时，我似乎无法正常工作的 SendKeys "%S"。只要它可以通过 VBS 工作就可以了，因为我知道批处理触发器会很好地执行；我只是想为什么不包含它并分享我认为实际上非常酷的代码。我尝试过尝试调用和更改前景窗口，但无济于事。任何帮助表示赞赏。

Annoyingly Impossible Popup

Click Button Inspect Element Info

Folder with all Files

Answer 1

这不是您问题的完整答案。但我无法将此 VBA 代码添加到 cmets。 我使用此过程强制将文件从 xlsm/xls/xlsb 重新保存到 xlsx。输入参数是要重新保存的文件的全名。

Function procSaveAS(fn As String) As Boolean

   On Error GoTo ErrSt
Application.DisplayAlerts = False
   Workbooks.Open Filename:=fn, _
       AddToMru:=False, Notify:=False, IgnoreReadOnlyRecommended:=True, UpdateLinks:=0, ReadOnly:=True
    
Application.DisplayAlerts = True
   st = LCase(Right(fn, 4))
   fnn = fn
   If st = "xlsm" Or st = "xlsb" Then
    fnn = Left(fnn, Len(fnn) - 1)
    
   End If
   Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=fnn & "x", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      ActiveWorkbook.Saved = True
   Application.DisplayAlerts = True
   ActiveWindow.Close SaveChanges:=False
    procSaveAS = True
    Exit Function
ErrSt:
    procSaveAS = False
End Function

附：程序调用成功后，我杀死了源文件。