无法将数据透视表设置为工作簿连接 (ACCESS DB)

Question

目标：将我的数据透视表直接连接到源数据库表（在 MS-ACCESS 2010 中）。

状态：我可以通过 VBA 将WorkbookConnection 设置到数据库。 我还可以使用代码创建PivotTable：

WB.PivotCaches.Create(SourceType:=xlExternal, SourceData:=Conn) _
                .CreatePivotTable TableDestination:=Worksheets("ManHours").Range("A1"), _
                TableName:="OnePager"

但是，尝试使用以下 2 个选项 Set PvtTbl 会产生运行时错误 (1004)：

选项 1：

Set PvtTbl = PvtCache.CreatePivotTable(TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager")

选项 2：

Set PvtTbl = Worksheets("ManHours").PivotTables.Add(PivotCache:=PvtCache, TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager")

我的代码

Option Explicit

Sub Dynamic_PivotTable()

Dim WB As Workbook
Dim WBConns As WorkbookConnection
Dim Conn    As WorkbookConnection
Dim ConnString As String

Dim PvtTbl      As PivotTable
Dim PvtCache    As PivotCache

Set WB = Workbooks("DynamicPivot_Connection.xlsm") '<-- Workbook is open

' define ConnectionString
ConnString = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=J:\PMO\Resource allocation\DB\Resource_DB.accdb;" & _
            "Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" & _
            "Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;" & _
            "Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;" & _
            "Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;" & _
            "Jet OLEDB:Bypass UserInfo Validation=False"

' loop through all Workbook connections and delete all except "Resource_DB"
For Each WBConns In WB.Connections
    Select Case WBConns.Name
        Case "Resource_DB"
            Set Conn = WBConns
        Case Else
            WBConns.Delete        
    End Select
Next WBConns

If Conn Is Nothing Then
    Set Conn = WB.Connections.Add("Resource_DB", "Resource DB Full Data Set", ConnString, "Select * from MergedDBTbl", 3)
End If

' set the Pivot Cache to update Workbook connection
Set PvtCache = WB.PivotCaches.Add(xlExternal, Conn)

' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PvtTbl = Worksheets("ManHours").PivotTables("OnePager") ' check if "OnePager" Pivot Table already created (in past runs of this Macro)

On Error GoTo 0
If PvtTbl Is Nothing Then

    ' create a new Pivot Table in "ManHours" sheet, start from Cell A1                   
    WB.PivotCaches.Create(SourceType:=xlExternal, SourceData:=Conn) _
                .CreatePivotTable TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager"

    ' create a new Pivot Table in "Pivot" sheet, start from Cell A1  ******* LINE BELOW PRODUCES AN ERROR ******
    Set PvtTbl = Worksheets("ManHours").PivotTables.Add(PivotCache:=PvtCache, TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager")


    ' ******* LINE BELOW PRODUCES AN ERROR ******
    Set PvtTbl = PvtCache.CreatePivotTable(TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager")
     'Create the headings and row and column orientation and all of your other settings here

Else
    ' just refresh the Pivot cache with the updated Range (data in "ManHours" worksheet)
    PvtTbl.ChangePivotCache PvtCache  '<--- ALSO PRODUCES AN ERROR !
    PvtTbl.RefreshTable
End If

End Sub

Answer 1

你应该使用：

Set PvtCache = WB.PivotCaches.Create(xlExternal, Conn)

而不是：

Set PvtCache = WB.PivotCaches.Add(xlExternal, Conn)

要在打开工作簿时自动刷新数据透视表，请使用：

PvtCache.RefreshOnFileOpen = True