任务计划 打开 Excel 文件，刷新 Bloomberg 数据，然后保存并关闭文件

Question

我已尝试收集我可以完成的所有代码，但它仍然不适合我。 我想要做的是安排我的 Excel 文件的任务，我有代码“RunExcel.vbs”作为附件，但仍然无法正常工作。

参考链接：How to set recurring schedule for xlsm file using Windows Task Scheduler

参考链接：https://www.mrexcel.com/forum/excel-questions/794869-vb-script-refresh-bloomberg-feed-excel.html

1. 打开“TEst 文件夹”中的文件“PriceRealTIme.xlsm”（启用宏的工作簿）。
2. 忽略更新链接
3. 让它“刷新 Bloomberg 数据”并“等待 1 分钟或直到刷新完成”。
4. 一旦完成。我想使用名为“CopyPaste”的宏复制这些列的粘贴值。
5. 最后，让它“保存”和“关闭”文件。

  '   a .vbs file is just a text file containing visual basic code that has the extension renamed from .txt  to .vbs

'Write Excel.xls  Sheet's full path here
strPath = "C:\Users\chaic\OneDrive\Desktop\TEst\PriceRealTIme.xlsm" 

'Write the macro name - could try including module name
strMacro = "Sheet1.CopyPaste" 

  'Create an Excel instance and set visibility of the instance
Set objApp = CreateObject("Excel.Application") 
objApp.Visible = True   '   or False 

  'Open workbook; Run Bloomberg Addin; Run Macro; Save Workbook with changes; Close; Quit Excel
Set wbToRun = objApp.Workbooks.Open(strPath) 

Private Const BRG_ADDIN As String = "BloombergUI.xla"
Private Const BRG_REFRESH As String = "!RefreshAllStaticData"
Private TimePassed As Integer

Sub StartAutomation()
    Dim oAddin As Workbook
    On Error Resume Next
    Set oAddin = Workbooks(BRG_ADDIN)
    On Error GoTo 0
    If Not oAddin Is Nothing Then
        Application.Run BRG_ADDIN & BRG_REFRESH
        StartTimer
    End If
End Sub

Private Sub StartTimer()
    TimePassed = 10
    WaitTillUpdateComplete
End Sub

Sub WaitTillUpdateComplete()

    If WorksheetFunction.CountIf(ThisWorkbook.Names("BloombergDataRange").RefersToRange,"#VALUE!") = 0 Then
        Application.StatusBar = "Data update used " & TimePassed & "seconds, automation started at " & Now
    Else
        Application.StatusBar = "Waiting for Bloomberg Data to finish updating (" & TimePassed & " seconds)..."
        TimePassed = TimePassed + 1
        Application.OnTime Now + TimeSerial(0, 0, 1), "WaitTillUpdateComplete"
    End If

End Sub

objApp.Run strMacro     '   wbToRun.Name & "!" & strMacro 
wbToRun.Save 
wbToRun.Close 
objApp.Quit 

   'Leaves an onscreen message!
MsgBox strPath & " " & strMacro & " macro and .vbs successfully completed!",         vbInformation

Answer 1

这是一个古老的威胁，但也许这个答案会对其他人有所帮助。 下面的代码对我有用。计算机已设置为永不休眠或锁定屏幕。

计算机正在使用 Office 365 和 excel 2016。

      '   a .vbs file is just a text file containing visual basic code that has the extension renamed from .txt  to .vbs

'Write Excel.xls  Sheet's full path here
strPath = "myPath" 


'Create an Excel instance and set visibility of the instance
Set objApp = CreateObject("Excel.Application") 
objApp.Visible = False   '   or True 

Set wbToRun = objApp.Workbooks.Open(strPath) 


StartAutomation

Sub StartAutomation()
    Dim oAddin
    Set oAddin = objApp.Workbooks.Open("C:\blp\API\Office Tools\BloombergUI.xla")
    objApp.Addins("Bloomberg Excel Tools").Installed = False
    objApp.Addins("Bloomberg Excel Tools").Installed = True

    If Not oAddin Is Nothing Then
        objApp.DisplayAlerts = False
        objApp.Calculate
        objApp.Run "RefreshAllStaticData"
        objApp.Calculate
        objApp.Run "RefreshAllStaticData"

        WaitTillUpdateComplete

    End If
End Sub

Dim t
t = 0

Private Sub WaitTillUpdateComplete()
    objApp.Calculate
    If objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#NAME?") > 0 Then
        Application.OnTime Now + TimeValue("00:00:15"), "WaitTillUpdateComplete"
    ElseIf objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#N/A") > 0 Then
        Application.OnTime Now + TimeValue("00:00:15"), "WaitTillUpdateComplete"
    ElseIf objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#N/A Requesting Data...") > 0 Then
        If t < 5 Then
            t = t+ 1
            waitlonger
        Else
            Exit Sub
        End If
    Else
        Exit Sub
    End If

End Sub

Sub waitlonger()
    Dim x
    x = Now + TimeValue("00:00:40")
    Do While x > Now
    Loop
    objApp.Calculate
End Sub


wbToRun.Save 
wbToRun.Close
objApp.DisplayAlerts = False 
objApp.Quit