VBA打开Excel文件,刷新Bloomberg数据,保存,关闭

时间:2018-08-13 22:10:51

标签: excel vba excel-vba batch-file bloomberg

我正在尝试编写一个在批处理文件中调用的vba脚本,以打开excel文件,刷新Bloomberg数据,保存文件,然后退出excel。
曾经有一个历史性的问题,它提出了类似的要求,但是建议的答案似乎不起作用-我可以打开文件并刷新数据,但是它无法保存文件或关闭excel。
我也尝试将workbook_open文件作为宏插入,但是遇到一个问题,即excel在刷新数据之前先保存并关闭文件。任何建议将不胜感激。
紧随其后的是修改后的vba代码,该代码刷新数据,但不保存或关闭excel工作簿。

 'Write Excel.xls  Sheet's full path here
 strPath = "C:\MngXL\testbook.xlsm" 

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

 Set wbToRun = objApp.Workbooks.Open(strPath) 

 StartAutomation
 DoneNow

 Sub StartAutomation()
     Dim oAddin
     Set oAddin = objApp.Workbooks.Open("C:\blp\API\Office      Tools\BloombergUI.xla")

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

    dim count 
    dim updated 
    updated = false 
    for count = 0 to 12 
        if updated = false then
            if      objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#N/A Requesting Data...") = 0      Then
                updated = true
            else
                Application.OnTime Now + TimeValue("00:00:15"),      WaitTillUpdateComplete
            end if
        end if
    next

 End Sub

 Private Sub WaitTillUpdateComplete()
     Dim t
    t = 0
    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

 Sub DoneNow()
    wbToRun.Save 
    wbToRun.Close
    objApp.DisplayAlerts = False 
    objApp.Quit 
    MsgBox strPath & " " & strMacro & " macro and .vbs successfully      completed!!!!", vbInformation
 End Sub

1 个答案:

答案 0 :(得分:2)

您需要一种策略来让彭博数据的刷新花费正确的时间。

当前,您的程序似乎只允许经过少量时间而没有反馈。相反,您需要创建一个循环,该循环每10秒(或任何有意义的循环)循环一次,并检查程序是否完成。

我喜欢这样:

dim count as integer
dim updated as boolean

updated = false
for count = 1 to 12 'or any value you choose
   if updated = false then
      if objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#NAME?") = 0 Then
         updated = true
      else
         Application.OnTime Now + TimeValue("00:00:15"), "WaitTillUpdateComplete"
      end if
   end if      
next