vba 更改透视表的access数据源

JiaDongjun

请问我当前Excel透视表的数据源为一个access数据库当中的表，现在我想更换为另外一个新的数据库作为数据源，应该怎么写呢？
录的宏改了改，但是数据源没有变

1. Private Sub 修改需要连接的数据库()
   
2. 
   
3. '    tool = ThisWorkbook.Name
   
4.     Sheets("目录").Select
   
5.     dbName = Range("J3")
   
6.     dtName = Range("J4")
   
7.     DataSource = ThisWorkbook.Path & "" & dbName & ".accdb"
   
8.     pt = "数据透视表3"
   
9.    
   
10.     ThisWorkbook.Connections.Add2 dbName, "", _
    
11.         Array( _
    
12.         "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & DataSource & ";Mode=Share Deny Writ" _
    
13.         , _
    
14.         "e;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine" _
    
15.         , _
    
16.         " Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New" _
    
17.         , _
    
18.         " Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Com" _
    
19.         , _
    
20.         "pact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Byp" _
    
21.         , _
    
22.         "ass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False" _
    
23.         ), dtName, 3
    
24.         
    
25.    
    
26.     For Each Sheet In Sheets
    
27.         On Error Resume Next
    
28.         Sheet.PivotTables(pt).ChangeConnection ActiveWorkbook.Connections(dbName)
    
29.     Next
    
30.    
    
31. End Sub

复制代码

clyfd

上个附件看看呗