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

时间:2017-01-30 12:46:17

标签: excel-vba connection-string pivot-table vba excel

目标:将我的数据透视表直接连接到源数据库表(在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

1 个答案:

答案 0 :(得分:2)

您应该使用:

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

而不是:

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

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

PvtCache.RefreshOnFileOpen = True