打开/closures工作簿和刷新连接

我有一个共享的networking驱动器上的两个工作簿：

• 工作簿A（表）
• 工作簿B（数据透视表 – 连接到源工作簿A）

我试图在打开工作簿B时运行macros并执行以下操作：

1. 在工作簿B上取消保护某个工作表
2. 如果工作簿A处于打开状态，请刷新工作簿B上的数据连接
3. 如果工作簿A已closures，请打开工作簿A并刷新工作簿B上的数据连接，然后closures工作簿A.
4. 保护工作簿B上的某个工作表

下面的代码在大多数情况下的testing到目前为止都是按照预期进行的，但是如果其他人试图在其他人在另一台计算机上打开工作簿A时在其计算机上打开工作簿B，则会将工作簿A作为只读文件打开并保留在他们的电脑上打开。 我需要closures他们的电脑，并保持其他电脑上打开的第一个。

Public Sub RefreshPvt() ThisWorkbook.Worksheets("Sheet1").Unprotect Application.ScreenUpdating = False Application.DisplayAlerts = False Dim wkb As Workbook If IsFileOpen("S:\\Testing\Job Closeout Status Test.xlsx") Then ThisWorkbook.RefreshAll Else Set wkb = Workbooks.Open(filename:="S:\\Testing\Job Closeout Status Test.xlsx") ThisWorkbook.RefreshAll wkb.Close SaveChanges:=False End If ThisWorkbook.Worksheets("Sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Function IsFileOpen(filename As String) Dim filenum As Integer, errnum As Integer On Error Resume Next ' Turn error checking off. filenum = FreeFile() ' Get a free file number. ' Attempt to open the file and lock it. Open filename For Input Lock Read As #filenum Close filenum ' Close the file. errnum = Err ' Save the error number that occurred. On Error GoTo 0 ' Turn error checking back on. ' Check to see which error occurred. Select Case errnum ' No error occurred. ' File is NOT already open by another user. Case 0 IsFileOpen = False ' Error number for "Permission Denied." ' File is already opened by another user. Case 70 IsFileOpen = True ' Another error occurred. Case Else Error errnum End Select End Function 

Answer 1

如果在即时窗口中的工作簿B上运行ThisWorkbook.RefreshAll，它是否工作？

你也可以使XLApp.Visible = true来查看它是否打开

我想你应该使用更像是的东西：

 Dim pt As PivotTable For Each pt In ActiveSheet.PivotTables pt.RefreshTable Next pt 

要完成整个工作簿，您可以使用：

 Sub AllWorkbookPivots() Dim pt As PivotTable Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets For Each pt In ws.PivotTables pt.RefreshTable Next pt Next ws End Sub