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

时间:2018-03-14 03:30:24

标签: excel vba vbscript schedule bloomberg

我试图收集我本可以完成的所有代码,但它仍然无效。 我想要做的是安排我的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. 打开文件“PriceRealTIme.xlsm”(启用宏的工作簿),位于“TEst文件夹”中。
  2. 忽略更新链接
  3. 让它“刷新Bloomberg数据”并“等待1分钟或直到它完成更新”。
  4. 一旦完成。我想使用名为“CopyPaste”的宏来复制这些列的粘贴值。
  5. 最后,让它“保存”和“关闭”文件。
  6.   '   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
    

1 个答案:

答案 0 :(得分: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