自动从外部工作簿更新值

时间:2013-04-15 09:25:29

标签: excel excel-vba scripting vbscript wsh vba

我有以下工作簿设置:

enter image description here

工作簿A包含x个工作簿B的链接,并从中获取数据。工作簿B链接到其他一些工作簿并从中获取数据。

工作簿A是所有其他工作簿包含的“摘要”。就像现在一样,我必须在打开工作簿A之前打开所有工作簿B,刷新并保存。如果我不这样做,工作簿B将不会更新工作簿C中的数据。

是否可以使用.bat或vbs脚本更新所有工作簿B?或者是否可以从工作簿A中更新它们?

我可能会补充一点,我在这台计算机上使用excel启动器,所以最好是解决方案兼容。

3 个答案:

答案 0 :(得分:5)

附件是一个可能的解决方案可以从vba运行,如果可以的话

感谢Sid Rout建议编辑RecursiveFile(objWB)

警告:有太多同时打开的书籍(我在vbs递归地狱期间达到512)可能会导致内存问题 - 在这种情况下,每个主要分支应该依次更新,然后在进入下一个分支之前关闭这些工作簿。

它的作用

  1. 打开strFilePath
  2. 所持有的工作簿
  3. 检查1中是否有任何链接的工作簿,如果是,则打开它们(B,B1,B2等)
  4. 代码然后查找(2)中每个工作簿中的任何链接,然后依次打开所有这些链接(B和C2等的C1和C2)
  5. 每个打开的图书名称都存储在一个数组Arr
  6. 打开所有图书后,初始工作簿将更新,递归代码结束,除strFilePath以外的所有已打开的图书都将关闭而不保存
  7. 然后保存并关闭
  8. strFilePath
  9. 代码整理
  10. 编辑:更新了修复vbs递归问题的代码

    Public objExcel, objWB2, lngCnt, Arr()
    Dim strFilePath, vLinks
    `credit to Sid Rout for updating `RecursiveFileRecursiveFile(objWB)`
    
    Erase Arr
    lngCnt = 0
    
    Set objExcel = CreateObject("Excel.Application")
    strFilePath = "C:\temp\main.xlsx"
    
    With objExcel
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set objWB = objExcel.Workbooks.Open(strFilePath, False)
    Call RecursiveFile(objWB)
    
    For Each vArr In Arr
        objExcel.Workbooks(vArr).Close False
    Next
    
    objWB.Save
    objWB.Close
    Set objWB2 = Nothing
    
    With objExcel
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .Quit
    End With
    
    Set objExcel = Nothing
    MsgBox "Complete"
    
    Sub RecursiveFile(objWB)
        If Not IsEmpty(objWB.LinkSources()) Then
            For Each vL In objWB.LinkSources()
                ReDim Preserve Arr(lngCnt)
    
                'MsgBox "Processing File " & vL
    
                Set objWB2 = objExcel.Workbooks.Open(vL, False)
                Arr(lngCnt) = objWB2.Name
                lngCnt = lngCnt + 1
                RecursiveFile objWB2
            Next
        End If
    End Sub
    

    工作ScreenShots

    enter image description here

答案 1 :(得分:2)

是的,您可以遍历所有源B工作簿,在后台打开它们并将UpdateLinks标志设置为True ...

strFiles=Dir(*path & \.xls*)

do
    workbooks.open strfiles, UpdateLinks:=true
    workbooks(strfiles).close savechanges:=true
    strFiles=Dir
loop while strfiles<>""

应该给你一个开始

答案 2 :(得分:2)

因此,由于VBA不是一个选项,让我们尝试VB脚本解决方案:

dim objFSO, objExcel, objWorkbook, objFile
'
set objExcel= CreateObject("Excel.application")
'
objExcel.visible=false
objExcel.displayalerts=false
'
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = path
'
Set objFolder = objFSO.GetFolder(objStartFolder)
' get collection of files from folder
Set colFiles = objFolder.Files
' begin loop through all files returned by Files collection of Folder object
For Each objFile in colFiles
    ' sanity check, is the file an XLS file?
    if instr(objfile.name,"xls")<>0 then ' could also use right(objfile.name,4)=...
        Wscript.Echo "Opening '" objFile.Name & "' ..."
        set objWorkbook=objexcel.workbooks.open objfile.name, updatelinks:=true
        objexcel.workbooks(objfile.name).close savechanges:=true
    end if
Next
' close Excel
objexcel.quit
' kill the instance and release the memory
set objExcel=nothing

尝试一下,看看你如何上场

这是VB脚本SDK:MSDN Library - VB Script